I am using the following code to refresh Excel pivot tables from an Access application. What is the best way to save and close the Excel app after the pivots refresh? In my last attempt the code was trying to save and close before the pivots had refreshed.
Private Sub Command161_Click()
Dim objXL As Object, x
On Error Resume Next
Set objXL = CreateObject("Excel.Application")
With objXL.Application
.Visible = True
'Open the Workbook
.Workbooks.Open "myfilepath.xls"
'Refresh Pivots
x = .ActiveWorkbook.RefreshAll
End With
Set objXL = Nothing
End Sub
Set the pivottable.pivotcache.backgroundquery property to False for synchronous updates.
Related
From MS Access I am generating several MS Access Workbooks. Via the following code I am getting the desired save location for all of the workbooks. The following code was working without issues a few days ago. Now it abruptly fails with no error number. MS Access crashes and I get a prompt to restart MS Access and a backup file is automatically created of the MS Access project I am working on.
Strangely the code works fine if I step through it with the debugger. It simply is not working at full speed.
UPDATE 1:
If I do the falling the save_location call works.
Private Sub make_report()
' TODO#: Change to late binding when working
Dim strSaveLocation as string
Dim xl as Excel.Application
dim wb as Excel.Workbook
strSaveLocation = save_location("G:\Group2\Dev\z_report")
Set xl=New Excel.Application
' do workbook stuff
With xl
strSaveLocation = strSaveLocation & "\report_name.xlsx"
wb.SaveAs strSavelLocation, xlOpenXMLWorkbook
End With ' xl
Set xl=nothing
End Sub
If I call the save_location function like this it abruptly crashes MS Access. It doesn't throw an error or anything. It just crashes.
Private Sub make_report()
' TODO#: Change to late binding when working
Dim strSaveLocation as string
Dim xl as Excel.Application
dim wb as Excel.Workbook
Set xl=New Excel.Application
' do workbook stuff
With xl
' the call to save_location is inside of the xl procedure
strSaveLocation = save_location("G:\Group2\Dev\z_report")
strSaveLocation = strSaveLocation & "\report_name.xlsx"
wb.SaveAs strSavelLocation, xlOpenXMLWorkbook
End With ' xl
Set xl=nothing
End Sub
By moving the save_location call inside the Excel.Application work string it fails. I don't understand why.
Private Function save_location(Optional ByVal initialDir As String) As String
On Error GoTo err_trap
Dim fDialog As Object
Dim blMatchIniDir As Boolean
Set fDialog = Application.FileDialog(4) ' msoFileDialogFolderPicker
With fDialog
.Title = "Select Save Location"
If NOT (initialDir=vbnullstring) then
.InitialFileName = initialDir
End If
If .Show = -1 Then
' item selected
save_location = .SelectedItems(1)
End If
End With
Set fDialog = Nothing
exit_function:
Exit Function
err_trap:
Select Case Err.Number
Case Else
Debug.Print Err.Number, Err.Description
Stop
Resume
End Select
End Function
Actions tried:
Decompile project and recompile
Create new MS Access project and import all objects
Compact and repair
Reset all reference
Notes:
I am using the client's system and
I don't know of any system updates
Client's system is a virtual desktop via VMWare
Office 2013
Windows 7 Pro
while i am not sure if this is the specific problem - but if it is the case, it messes with anything VBA. Check the folder names and file names for any apostrophes. While windows allows this, an apostrophe will be seen in VBA as a comment, and will crash it. Have the client walk you through the exact file that he selects to confirm there is no apostrophe character in the filename or folder name.
I camse across an old post which had the pefect solution for my requirement - 'Creating a Document Database Using Microsoft Access' with the answer provided by Renaud BomPuis in the form of a sample database (https://dl.dropboxusercontent.com/u/52900980/StackOverflow/SO25044339.accdb).
I have been able to manipulate the source code for this to suit my needs and successfully insert it into my main database. The only problem I have is that it creates a new record at the wrong point for me. When the user clicks 'Upload File' a new record is created and a form opens to be able to select the file using file dialog. But if the user changes their mind and clicks cancel, the record is already created but empty of a file path.
I would like to be able to only create a new record if the user confirms it but I cannot seem to manipulate the code into the correct order for it to work.
Can anybody help please? Many thanks.
EDIT: Code from comment
Private Sub btnUploadDoc_Click() ' Create a new record in the Documents table for the selected Works No
Dim DocID As Variant
Dim db As dao.Database
Dim rs As dao.Recordset
Set db = CurrentDb()
Set rs = db.OpenRecordset("tblDocuments", dbOpenDynaset, dbFailOnError)
With rs
.AddNew !WorksNo = cboWorksNo
.Update
.Move 0, .LastModified
DocID = !DocID
.Close
End With
Set rs = Nothing
Set db = Nothing
DoCmd.OpenForm "frmDocSelect", WhereCondition:="DocID=" & DocID
End Sub
This will not be a trivial change, since (I assume) frmDocSelect depends on an existing record in tblDocuments.
The best way to proceed is probably to simply delete the new record if the user clicks Cancel.
Something like
Sub cmdCancel_Click()
Dim DocID As Long
DocID = Me.DocID
' Close form before deleting, to avoid a flicker of "#Deleted"
DoCmd.Close acForm, Me.Name, acSaveNo
CurrentDb.Execute "DELETE * FROM tblDocuments WHERE DocID=" & DocID
End Sub
Using VBA Access, I'm trying to edit the below code. So that it first checks if an excel file is open , if already open wait till file is closed then resume code? this needs to be done for each file 1,2,3.
Check if excel file is open
If open wait(Pause) till closed then resume code (Refresh table ,save, close)
Repeat process for the next file.
Function RefreshExcelTables()
Dim ExcelApp As Object
Set ExcelApp = CreateObject("Excel.Application")
ExcelApp.workbooks.Open "c:\test\Test_Sheet1.xlsb"
ExcelApp.ActiveWorkbook.refreshall
ExcelApp.ActiveWorkbook.Save
ExcelApp.ActiveWindow.Close
ExcelApp.workbooks.Open "c:\test\Test_Sheet2.xlsb"
ExcelApp.ActiveWorkbook.refreshall
ExcelApp.ActiveWorkbook.Save
ExcelApp.ActiveWindow.Close
ExcelApp.workbooks.Open "c:\test\Test_Sheet3.xlsb"
ExcelApp.ActiveWorkbook.refreshall
ExcelApp.ActiveWorkbook.Save
ExcelApp.ActiveWindow.Close
Set ExcelApp = Nothing
End Function
tested in Outlook
Sub Test()
Dim ExcelApp As Object
Dim X, X1
X = Array("c:\test\Test_Sheet1.xlsb", "c:\test\Test_Sheet2.xlsb")
For Each X1 In X
On Error Resume Next
Set ExcelApp = GetObject(X1).Application
On Error GoTo 0
If Not ExcelApp Is Nothing Then
With ExcelApp.Workbooks(Right$(X1, Len(X1) - InStrRev(X1, "\")))
.RefreshAll
.Save
.Close
End With
Set ExcelApp = Nothing
End If
Next X1
End Sub
I am facing a strange situation with my MS Access VBA Code. I have a form with several buttons for importing data into tables coming from different Excel files.
In the form, 2 buttons have to open the same Excel workbook but different sheets. In order to do this, I called the following subroutine in one of the buttons:
Sub solar_solar(showNotification As Boolean)
Dim xlApp As Excel.Application
Dim eexWB As Workbook
Dim updatedDates As String
Dim insertedDates As String
On Error GoTo errorHandling
' open excel application and source file
Set xlApp = CreateObject("Excel.Application")
xlApp.Visible = False
xlApp.DisplayAlerts = False
Set eexWB = xlApp.Workbooks.Open(c_sourceFile_solar, False, True)
' update records
updatedDates = updateWindOrSolarRecords(eexWB, cWindSheet, cStartRowWind, cStartColWind, c_sql_WindTable)
' more code ...
End Sub
The other subroutine (wind_wind) has exactly the same code for opening the excel file. The solar_solar subroutine runs just fine but when then I try to run the second one, the code does not start executing and I get the alert: "Object library feature not supported" (Fehler beim Kompilieren: Funktionsmerkmal der Objektbibliothek nicht unerstützt) and points to the line:
Set xlApp = CreateObject("Excel.Application")
This occurs in Windows 7 MS Access 2002. I do not understand how it is possible for this code to run well in one subroutine and not in another, when it is practically the same. Has anyone experienced something similar? Any advice?
Thanks.
Line labels may only occur once in each module as line label scope is the module level. You need to make sure every single line label is unique within any given module.
Currently you have something like this:
Sub solar_solar(showNotification As Boolean)
On Error GoTo errorHandling
'...
errorHandling:
'...
End Sub
Sub wind_wind(showNotification As Boolean)
On Error GoTo errorHandling
'...
errorHandling: 'This is bad!
'...
End Sub
Change the line labels and goto statements to be like the following:
`
Sub solar_solar(showNotification As Boolean)
On Error GoTo solar_errorHandling
'...
solar_errorHandling:
'...
End Sub
Sub wind_wind(showNotification As Boolean)
On Error GoTo wind_errorHandling
'...
wind_errorHandling:
'...
End Sub
http://support.microsoft.com/kb/78335
I need help coming up with a method to allow a user to export a query's results to an xls file on a button click event.
I've tried using an Output To macro, but it doesn't work for a query containing 30,000+ records.
Thanks in advance
You might want to consider using Automation to create an Excel spreadsheet and populate it on your own rather than using a macro.
Here's a function I have used in the past to do just that.
Public Function ExportToExcel(FileToCreate As String, ByRef rst As ADODB.Recordset)
'Parms: FileToCreate - Full path and file name to Excel spreadsheet to create
' rst - Populated ADO recordset to export
On Error GoTo Err_Handler
Dim objExcel As Object
Dim objBook As Object
Dim objSheet As Object
'Create a new excel workbook; use late binding to prevent issues with different versions of Excel being
'installed on dev machine vs user machine
Set objExcel = CreateObject("Excel.Application")
Set objBook = objExcel.Workbooks.Add
'Hide the workbook temporarily from the user
objExcel.Visible = False
objBook.SaveAs (FileToCreate)
'Remove Worksheets so we're left with just one in the Workbook for starters
Do Until objBook.Worksheets.Count = 1
Set objSheet = objBook.Worksheets(objBook.Worksheets.Count - 1)
objSheet.Delete
Loop
Set objSheet = objBook.Worksheets(1)
rst.MoveFirst
'Use CopyFromRecordset method as this is faster than writing data one row at a time
objSheet.Range("A1").CopyFromRecordset rst
'The UsedRange.Rows.Count property can be used to identify the last row of actual data in the spreadsheet
'This is sometimes useful if you need to add a summary row or otherwise manipulate the data
'Dim lngUsedRange As Long
'lngUsedRange = objSheet.UsedRange.Rows.Count
'Save the spreadsheet
objBook.Save
objExcel.Visible = True
ExportToExcel = True
Err_Handler:
Set objSheet = Nothing
Set objBook = Nothing
Set objExcel = Nothing
DoCmd.Hourglass False
If Err.Number <> 0 Then
Err.Raise Err.Number, Err.Source, Err.Description
End If
End Function
Can you use VBA?
Intellisense will help you, but get started with:
DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel9, "my_query_name", "C:\myfilename.xls"
Note: you may have a different Excel version
"my_query_name" is the name of your query or table
you'll need to set the file location to the appropriate location\name .extension
More Info: http://msdn.microsoft.com/en-us/library/bb214134.aspx