I have an application in Access 2007 that is creating a workbook with N sheets i created a macro to be inserted into this workbook which works perfectly fine. But the next step is to add a Shortcut Key to the Marco so far i've seen to methods online to assist. The First attempt gives no errors but does not assign the shortcut key either
1)
Excel_App.OnKey "^{h}", "Sheet1.HideChange"
2)Excel_App.MacroOptions Macro:="Sheet1.HideChange", Description:="Hide Columns in Line Level", hasshortcutkey:=True, ShortcutKey:="h"
My variables assigned to my method
Dim Excel_App As Excel.Application
Dim wkb As Excel.Workbook
Dim wks, wks2, wks3, wks4, wks5, wks6, wks7, wks8 As Excel.Worksheet
Dim i As Integer
Dim xlmodule As Object 'VBComponent
Dim coaches As Recordset
Set Excel_App = New Excel.Application
Excel_App.Visible = False
Set wkb = Excel.Workbooks.Add
Below is where i last placed the shortcut, i've attempted to move the line of code before and after saving however i still get 1004 err.
With wkb
ActiveSheet.Move Before:=Worksheets(1)
.Title = "CHANGE REQUEST"
.Subject = "CHANGE REQUEST"
' Add a macro to the module...
Dim strCode As String
strCode = _
"Sub HideChange()" & vbCr & _
" Columns(""A:A"").Select Selection.EntireColumn.Hidden = True " & vbCr & _
"end sub"
Dim module As VBComponent
Set module = wkb.VBProject.VBComponents(2)
module.CodeModule.AddFromString strCode
Excel_App.MacroOptions Macro:="Sheet1.HideChange", Description:="Hide Columns in Line Level", hasshortcutkey:=True, ShortcutKey:="h"
.SaveAs FileName:=strDir & "\CHANGE REQUEST FORM.xlsm", FileFormat:=xlOpenXMLWorkbookMacroEnabled
.Close
End With
Excel_App.Quit
Can anyone help me figure out how this works ?
if you need more details to my question please ask, Thank you for your time!
Try removing "Sheet1" from "Sheet1.HideChanges", it is not required (or correct).
MacroOptions :MSDN
OnKey :MSDN
Related
I am working on an export code to copy and export the current record I am viewing to an excel spreadsheet. Below is my code
Private Sub cmdExportFilename_Click()
Dim sFilename As String
Dim StrSQL As String
StrSQL = "Select * FROM [MainData] WHERE ([ID]=" & Me![ID] & ");"
sFilename = "C:\Desktop\exportResults.xlsx"
DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel9, StrSQL,
sFilename, True
End Sub
When I run this I get a Run-time error '3011' saying it could not find the object (though it pulls my Select string and correctly identifies I'm viewing record 86 with the error message" and says the object doesn't exist.
My previous code successfully exported data but it outputted the entire query results instead of just the viewed record.
Private Sub cmdExportFilename_Click()
Dim sFilename As String
sFilename = "C:\Users\cpastore\Desktop\exportResults.xlsx"
DoCmd.OutputTo acOutputForm, "OpenComplaintsQuery", acFormatXLSX, sFilename,
AutoStart:=True
End Sub
With Outputto command I do not see where I can select certain things in Parameters. So I thought I would try TransferSpreadsheet command instead.
My end goal ultimately is with the record I am viewing, when I click the button, it exports 6 or 7 fields of 25 that the form displays to an excel spreadsheet where those values Goto a very specific cell location in the sheet. I know with codes above I am a long way from there but I am slowly learning.
Edit: Adding new Code per June7 post suggestion. Ran into another Runtime Error
Private Sub cmdExportfield_Click()
Dim rsGroup As DAO.Recordset
Dim QIMS As String
Dim path As String
path = "C:\Desktop\"
Set rsGroup = CurrentDb.OpenRecordset("SELECT
OpenComplaintsQuery.QIMS# " & "FROM OpenComplaintsQuery GROUP
BY OpenComplaintsQuery.QIMS#", dbOpenDynaset)
Do While Not rsGroup.EOF
QIMS = rsGroup!QIMS#
Dim rsExportSQL As String
rsExportSQL = "Select * FROM OpenComplaintsQuery" & "WHERE
(((OpenComplaintsQuery.QIMS#='" & QIMS & "'))"
Dim rsExport As DAO.QueryDef
Set rsExport = CurrentDb.CreateQueryDef("myexportquerydef",
rsExportSQL)
DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel9,
"myexportquerydef", path & "exporttest.xlsx", True
CurrentDb.QueryDefs.Delete rsExport.Name
rsGroup.MoveNext
Loop
End Sub
I read through a pretty thorough response in the link How to search through VBA code files and it works just fine for the current project. However, I'm just feeling slow in opening up other projects and looking through their code.
The response mentioned using OpenDatabase but I'm not seeing examples about the association between the database and the Application.VBE.ActiveVBProject. I've not been lazy about this, but 4 days of searching the web has exhausted my options.
Any help would be really appreciated.
My apologies. Found other way to make this work.
Public Sub FindWordInOtherModules(ByVal pSearchWord As String, sApplicationFilePath As String)
Dim objComponent As VBComponent
' VBComponent requires reference to Microsoft Visual Basic
' for Applications Extensibility; use late binding instead:
Dim lStartLine As Long
Dim lEndLine As Long
Dim lStartColumn As Long
Dim lEndColumn As Long
Dim accApp As Access.Application
Set accApp = New Access.Application
With accApp
.Visible = True
.OpenCurrentDatabase (sApplicationFilePath)
.UserControl = True
'MsgBox .VBE.ActiveVBProject.VBComponents.Count
'MsgBox .CurrentDb.Name
For Each objComponent In .VBE.ActiveVBProject.VBComponents
If objComponent.CodeModule.Find(pSearchWord, lStartLine, lStartColumn, lEndLine, lEndColumn, _
FindWholeWord, MatchCase, PatternSearch) = True Then
MsgBox "Found text " & StringToFind & vbCrLf _
& "Start line: " & lStartLine & vbCrLf _
& "Line text: " & objComponent.CodeModule.Lines(lStartLine, lEndLine - lStartLine + 1), vbOKOnly, objComponent.CodeModule.Name
End If
Next objComponent
End With
accApp.CloseCurrentDatabase
Set accApp = Nothing
End Sub
You should probably add accApp.Quit:
accApp.CloseCurrentDatabase
accApp.Quit
Set accApp = Nothing
before Set accApp = Nothing to speed up closing the application and close it during execution of this code (Public Sub FindWordInOtherModules), on the line accApp.Quit, not later. On my computer mouse is still inactive several seconds after execution such kind of Sub if accApp.Quit is not added.
But there is no need to open another database, because the current database can be only "linked' to it by creating temporary reference:
Private Sub FindWordInOtherModules2()
Dim objComponent As VBComponent
...
...
Dim lEndColumn As Long
Dim ref As Reference
Dim RefName As String
Const FileName = "C:\Users\....mdb"
With Application 'instead of accApp
.References.AddFromFile FileName
'.References.Count because the new one is supposed be the last one (?)
RefName = .References(.References.Count).Name
Dim VBProj As VBProject
For Each VBProj In .VBE.VBProjects
If VBProj.FileName <> .CurrentDb.Name Then Exit For
Next
For Each objComponent In VBProj.VBComponents
'Debug.Print objComponent.Name
...
...
Next
Set objComponent = Nothing '?
Set VBProj = Nothing '?
Set ref = .References(RefName)
.References.Remove ref
Set ref = Nothing '??
End With
End Sub
This seems be faster then opening another database file, but VBA can't be updated.
References.Remove ref removes reference, but VBA folders are still visible in the left panel and all the code works, what is a little disturbing ...
Application.VBE.VBProjects.Remove VBProj doesn't work. It may have something to do with "Trust access to the VBA project object model" option in Trust Center - Macro Settings, which is not available in Access.
But the project is not visible after closing and opening the database.
I am parsing a worksheet into Access using the following code:
Sub LoadRates(ByRef TimesheetFile As Excel.Workbook)
On Error GoTo LoadDataCollection_Error
Dim i As Integer
Dim LastRow As Integer
Dim shRates As Excel.Worksheet
Set shRates = TimesheetFile.Worksheets("Rates")
shRates.ShowAllData
LastRow = shRates.Cells(shRates.Rows.Count, 1).End(xlUp).Row
shRates.Cells(1, 4).value = "Current"
Dim db As DAO.Database
Set db = CurrentDb
Dim strSQL As String
Dim dbWb As String
dbWb = "[Excel 12.0;HDR=YES;IMEX=1;Database=" & TimesheetFile.FullName & "].[Rates$A1:i" & LastRow & "]"
strSQL = "SELECT A.[Entity no] AS Entity,Staff AS Name, A.Current as Rates, Company, [2015 BCTC category] AS BCTC_Category,[2015 Rating] As Rating " & _
" INTO fromTimesheet " & _
" FROM " & dbWb & " AS A "
db.Execute strSQL, dbFailOnError
Exit Sub
LoadDataCollection_Error:
... do stuff...
End Sub
my problem is that I have to change the column 4's header to "Current" manually because the title is currently a date value, thus inappropriate for SQL to pick up
shRates.Cells(1, 4).value = "Current"
when I execute this code. sometimes it returns an error message saying it cannot find the field A.Current , and other times it would be able to find it. Is this caused by the workbook being set to Shared?
Any help would be appreciated.
Upon testing, I found out that this error has to do with the excel workbook being "Shared". Once I made the workbook exclusive, the code was able to pick up me editing the row value.
This leads me to believe that when I instantiate an excel workbook object that is being shared. It should be treated as read-only.
Hopefully this is helpful for others.
Yes, your column header is not being effectively saved and connection is using last saved instance.
Consider manually saving it after you make your change. Also, be sure you have write access to save workbook and not in shared/read-only (or alternatively save a different temp workbook for import):
shRates.Cells(1, 4).value = "Current"
TimesheetFile.Save
But also consider using DoCmd.TransferSpreadshet method instead of worksheet connection (which can facilitate "shared" process). Usually one uses a true database for connection and not flatfiles like spreadsheets.
Sub LoadRates(ByRef TimesheetFile As Excel.Workbook)
On Error GoTo LoadDataCollection_Error
Dim i As Integer, LastRow As Integer
Dim shRates As Excel.Worksheet
Set shRates = TimesheetFile.Worksheets("Rates")
shRates.ShowAllData
LastRow = shRates.Cells(shRates.Rows.Count, 1).End(xlUp).Row
shRates.Cells(1, 4).value = "Current"
TimesheetFile.Close True ' SAVES AND CLOSES
DoCmd.TransferSpreadsheet acImport, "fromTimesheet", _
TimesheetFile.FullName, True, "Rates!"
Exit Sub
LoadDataCollection_Error:
... do stuff...
End Sub
I have code written to pull a specific file from a folder, insert it into an attachment field (local_attachment) and which creates a new record in table TEMP_attachment. I am trying to pull all the files from a folder and have them each be a new record in the table but I keep running into issues where I either pull all the files and they all go into one record, or it won't pull any. Thank you for your help!!!
Here is my code:
Dim x As Long
Dim strFile As String
Dim db As DAO.Database
Dim rs As DAO.Recordset2
Dim rsA As DAO.Recordset2
Dim fld As DAO.Field2
Dim SQL As String
x = 1
strFile = "C:\dev\test_file2.txt"
SQL = "INSERT INTO TEMP_Attachment (ID) "
SQL = SQL & "VALUES (" & x & ")"
DoCmd.RunSQL SQL
Set db = CurrentDb
Set rs = db.OpenRecordset("TEMP_Attachment")
Set fld = rs("local_attachemnt")
'Navigate through the table
Set rsA = fld.Value
rs.Edit
rsA.AddNew
rsA("FileData").LoadFromFile strFile
rsA.Update
rs.Update
The problems with your code can be fixed my taking a more methodical approach. As I see it, you need to find all the files in the folder, add a record for each one, add an attachment record for the file, read the file data into the new record, and generate a unique key for the parent record.
Rather than try to do everything at once, let's break into pieces and take them in reverse order, so we're dealing with the smallest problems first:
First, let's figure out how we are going to generate a key. The easiest way to do this is to use an Autonumber field. Rather than cook up something fancier, I'm going to assume this is the solution you will use. This will make DoCmd.RunSQL unnecessary and simplify the whole operation.
Second, write a routine which adds one file to one record in the database, and make sure this is working. My suggestion would be to create parameters for a recordset to the main table and a path to the file, like so (I have not tested this, that will be your job. I've added error handlers to help you work out any issues):
Private Sub AddFileAttachment(ByRef rs As DAO.Recordset, ByVal sPath As String)
Dim rsAttachments As DAO.Recordset
On Error Goto EH
With rs
'(this will generate a new Autonumber in the main table)
.AddNew
'this will create a new attachment in the field and add it
Set rsAttachments = .Fields("local_attachemnt").Value
With rsAttachments
.AddNew
.Fields("FileData").LoadFromFile sPath
.Update
.Close
End With
'this is what adds the main record
.Update
End With
EH:
With Err
MsgBox .Number & vbcrlf & .Source & vbCrLf & .Description
End With
FINISH:
If Not rs Is Nothing Then
rs.Close
Set rs = Nothing
End If
If Not rsAttachments Is Nothing Then
rsAttachments.Close
Set rsAttachments = Nothing
End If
End Sub
And call it like so:
Private Sub cmdTest_Click()
Dim db As DAO.Database
Dim rs As DAO.Recordset
On Error Goto EH
Set db = CurrentDb
Set rs = db.OpenRecordset("TEMP_Attachment")
AddFileAttachment rs, "C:\dev\test_file2.txt"
Goto FINISH
EH:
With Err
MsgBox .Number & vbcrlf & .Source & vbCrLf & .Description
End With
FINISH:
rs.Close
End Sub
Important! Perfect the first routine before moving on. You should test it until you know it works over and over. You should be able to click the button it is attached to 10 times and each time get a new record with the file attached.
Once you know this is working, you are ready to write the main routine that calls it for each file you are attaching. I will not include that here, but would suggest researching the FileSystemObject. You should be able to find a lot of vba examples for how to get all the files in a folder. You would loop through them and call your routine for each file the same way it is called in the test above, passing in the open recordset.
I'm having trouble trying to export an Access report to PDF format. Basically, I'm working on an old (built in 2001) Access database that uses forms as a user interface. Currently, you can send jobs from a "Jobs" form into an "Invoice" form. Once all the jobs are there, you simply click "Invoice All", specify a date and number of copies and this prints using an Access report as the template.
I've been tasked with adding a save as PDF function, but being a web designer by trade, I have very limited knowledge of Access and VB, but I do know a (very) little amount of ASP.Net and C# (how I got given this task is story for another time...)
In my mind I've approached this by creating a new PDF button on the Access form where they print the invoices. My thoughts are that I could simply duplicate the code for the printing and update to output to a PDF file instead. I can kind of get this working, but not how I'd like.
The code for the print function is below:
Private Sub cmdOpenGroupInvoice_Click()
Dim db As DAO.Database
Dim rsGetCustomerInvoice As DAO.Recordset
Dim rsInvoice As DAO.Recordset
Dim rsInvoiceAll As DAO.Recordset
Dim lngCusID As Long
Dim lngJobNo As Long
Dim iCountInvoice
Dim lngInvoiceNo As Long
Dim iNumberCopies As Integer
Dim sSQLGetInv As String
Dim sSQLInv As String
Dim datInvoiceDate As Date
sSQLGetInv = "SELECT tblJobs.JobNo,tblJobs.NetDespatchRef, tblLoads.Sales, tblLoads.PODName, tblLoads.TotalSales, tblLoads.Cost, tblLoads.Profit, tblJobs.SendToInvoice, tblJobs.Invoiced, tblJobs.MarkForHistory, tblJobs.CustomerID" & vbCrLf _
& "FROM tblJobs INNER JOIN tblLoads ON tblJobs.JobNo = tblLoads.JobNo" & vbCrLf _
& "WHERE (((tblJobs.SendToInvoice)=Yes) AND ((tblJobs.Invoiced)=No) AND ((tblJobs.MarkForHistory)=No));"
Set db = CurrentDb
Set rsGetCustomerInvoice = db.OpenRecordset(sSQLGetInv, dbOpenDynaset)
If rsGetCustomerInvoice.EOF Then
Beep
If MsgBox("There are no jobs to invoice", _
vbCritical + vbOKOnly, _
"No Jobs To Invoice") = vbOK Then
Exit Sub
End If
End If
rsGetCustomerInvoice.MoveLast
Debug.Print rsGetCustomerInvoice.RecordCount
rsGetCustomerInvoice.MoveFirst
Do Until rsGetCustomerInvoice.EOF = True
Set rsGetCustomerInvoice = db.OpenRecordset(sSQLGetInv, dbOpenDynaset)
If rsGetCustomerInvoice.EOF Then
rsGetCustomerInvoice.Close
db.Close
Set rsGetCustomerInvoice = Nothing
Set db = Nothing
DoCmd.Close acForm, "frmInvoiceDate"
Exit Sub
End If
Debug.Print rsGetCustomerInvoice.RecordCount
datInvoiceDate = CVDate(txtInvoiceDate)
lngInvoiceNo = GiveMeAnInvoiceNo()
lngCusID = rsGetCustomerInvoice.Fields!CustomerID
Call AddNewInvoice(lngInvoiceNo, datInvoiceDate, True)
Debug.Print iCountInvoice
lngJobNo = rsGetCustomerInvoice![JobNo]
Call SendThisJobToSageAll(lngCusID, datInvoiceDate, lngInvoiceNo)
Call InvoiceAll(lngCusID, lngInvoiceNo)
Dim strPODName As String
If Not IsNull(rsGetCustomerInvoice!NetDespatchRef) Then
If IsNull(rsGetCustomerInvoice![PODName]) Then
strPODName = " "
Else
strPODName = rsGetCustomerInvoice![PODName]
End If
'Call NetDesTrackingJobCompleate(rsGetCustomerInvoice![NetDespatchRef], rsGetCustomerInvoice![JobNo], strPODName)
End If
iCountInvoice = iCountInvoice - 1
'Debug.Print I
iNumberCopies = txtNumberOfCopies
Do Until iNumberCopies = 0
DoCmd.OpenReport "rptInvoice2", acViewNormal, , "[Invoice No]= " & lngInvoiceNo
iNumberCopies = iNumberCopies - 1
Loop
Form_frmInvoicing.Requery
rsGetCustomerInvoice.MoveNext
Loop
DoCmd.Close acForm, "frmInvoiceDate"
rsGetCustomerInvoice.Close
db.Close
Set rsGetCustomerInvoice = Nothing
Set db = Nothing
End Sub
With my original plan outlined above, I updated the below section to output to PDF:
Do Until iNumberCopies = 0
DoCmd.OpenReport "rptInvoice2", acViewNormal, , "[Invoice No]= " & lngInvoiceNo
DoCmd.OutputTo acOutputReport, "", acFormatPDF, MyPath & MyFilename, True
iNumberCopies = iNumberCopies - 1
Loop
Now this works and it does attempt to output a PDF file. The trouble is, it's runs the report and creates an invoice for every job in the system, rather than applying the report to JUST the jobs which are marked for invoicing.
I'm hoping this is happening because I've put the code in the wrong location, but I have a gut feeling that it's more complicated than that.
It's a bit of a long shot posting it on here, but I really appreciate any help at this point. I've also tried to keep this as short as possible, so if there's any details which aren't clear, I'll help out.
That is quite convoluted, so I think the simplest thing to do, if you do not wish to dive in and tidy up, is to modify the query that the report is based on.
Dim qdf As QueryDef
Set qdf = CurrentDb.QueryDefs("MyReportQuery")
sSQL = "SELECT Whatever FROM MyTable WHERE [Invoice No]= " & lngInvoiceNo
qdf.SQL = sSQL
DoCmd.OutputTo acOutputReport, "rptInvoice2", acFormatPDF, _
MyPath & MyFilename, True
Unless you have Access 2007 with the Save as PDF Add-on or 2010, you may be best installing say, cutePDF, and printing to the PDF printer using DoCmd.PrintOut
I asked the same question a couple of years ago on UtterAccess..
There is a free library to do exactly what you need here: http://www.lebans.com/reporttopdf.htm
My original thread at UA is here : http://www.utteraccess.com/forum/Automatically-PDF-send-t1353547.html
I successfully used the library for a couple of years in several projects, mainly to generate quotes and invoices.
Hope this helps
PG