I´ve been getting an automation error and so far have been unsuccessful to prevent it.
Since it seems like the cause for this can be very different from case to case, i´ll try my best to describe my project:
Inside of a frontend workbook there is all the code and inside a backend workbook there is the relevant data.
On startup the frontend opens the backend like this
Set daten_betrieb = Workbooks.Open(speicherort & "GB-Backend-" & kuerzel_betrieb & ".xlsx", _
UpdateLinks:=0, _
ReadOnly:=True, _
IgnoreReadOnlyRecommended:=True, _
Notify:=False, _
CorruptLoad:=xlNormalLoad)
Everything works fine except when the user manually reopens the backend and closes it, while the frontend is still open.
I added the following line to the code
If daten_betrieb Is Nothing Then Call backend_betrieb
backend_betrieb is the sub that uses the Workbooks.Open method mentioned earlier.
Even though the backend is open (again), i still get 2147221080 - Automation error on this line:
If daten_betrieb.Sheets("Arbeitsmittel & AKZ").Cells(1, i).Value = Arbeitsmittel Then
daten_betrieb refers to the freshly opened Workbook which is set to this name.. why is this a problem? Any ideas?
Thanks in Advance!
Edit:
Maybe the problem is with If backend_betrieb Is Nothing Then call backend_betrieb
When stepping through I see that excel doesnt jump into the sub backend_betrieb(). Does excel somehow think that the name/variable "backend_betrieb" is still there --> not Nothing. But the Workbook behind it is closed which leads to the error?!
I found a way to handle the Error.
On Error Resume Next
If daten_betrieb.Sheets("Arbeitsmittel & AKZ").Cells(1, i).Value = Arbeitsmittel Then
xxx
End If
If Err.Number = -2147221080 Then
Set daten_betrieb = Nothing
GoTo Start
End If
On Error GoTo ErrorHandler
Start is at the beginning of the sub, before If daten_betrieb Is Nothing call backend_betrieb
So basically it really seems like the Workbook was closed (manually through the user) but the object/name/whatever "daten_betrieb" was not Nothing. So i had to set it to Nothing for the If daten_betrieb Is Nothing call backend_betrieb line to take action.
Related
So, the below code works just fine on my end. But, if I send the excel file containing the code below to a different person, they get the Run-time Error 52. I've tried several different iterations of the code below, but all keep coming up with the same error.
UPDATE: Error 52 Resolved, but error 1004 now occurs when reading the line containing the objConnection.Refresh statement.
I'm curious to learn what situations would cause something to work fine on my end but not on someone else's PC, and how best to circumvent this issue. Code below:
Sub Download_CSV()
Dim myURL As String
Dim PathExcel As String
Dim csvfilenamefull As String
PathExcel = Application.ActiveWorkbook.Path
csvfilenamefull = PathExcel & "\SharepointData.xlsx"
'Remove File if already there
If Dir(csvfilenamefull) <> "" Then
VBA.SetAttr csvfilenamefull, vbNormal ' remove any file attributes (e.g. read-only) that would block the kill command
VBA.Kill csvfilenamefull ' delete the file
End If
myURL = "https://company.sharepoint.com/sites/Shared%20Documents/Data.xlsx"
Workbooks.Open (myURL)
ActiveWorkbook.SaveAs filename:=csvfilenamefull, _
FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
'Run check to ensure the opened file has finished connect to online database
For Each objConnection In ActiveWorkbook.Connections
'Get current background-refresh value
bBackground = objConnection.OLEDBConnection.BackgroundQuery
'Temporarily disable background-refresh
objConnection.OLEDBConnection.BackgroundQuery = False
'Refresh this connection
objConnection.Refresh
'Set background-refresh value back to original value
objConnection.OLEDBConnection.BackgroundQuery = bBackground
Next
End Sub
I simply tried various bits of code from different recommendations on this site (all of which worked successfully on my computer), but continue to give the other party the Run Time Error 52.
Before this gets marked as a duplicate: It is not, as all the other saving errors seem to get a different MsgBox.
I am writing a macro that opens and closes a PowerPoint Presentation from Excel. Now I have the issue that when I am trying to save the PowerPoint file I get a pop up Message Box:
It says: "PowerPoint-Error while saving the file."
My code:
Dim pptPres As PowerPoint.Presentation
Dim pptApp As PowerPoint.Application
Set pptApp = New PowerPoint.Application
strPath = "S:\Folderxy\"
strFile = "filename.pptm"
strSave = "newFilename"
Set pptPres = pptApp.Presentations.Open(strPath & strFile, False, True, True)
Application.DisplayAlerts = False
On Error GoTo Errorhandler_tryAgain
tryAgain:
pptApp.DisplayAlerts = ppAlertsNone
strSave = "Test123"
pptPres.SaveAs strPath & strSave & ".pptx"
pptPres.Close
Exit Sub
Errorhandler_tryAgain:
Debug.Print "Errorhandler_tryAgain was opened!"
Application.Wait DateAdd("s", 1, Now) 'delay in seconds
GoTo TryAgain
First:
Even though I turned the DisplayAlerts off this one keeps popping up. However I can not easily reproduce this error. It occurs sometimes. Openening, closing and saving *.pptx files is part of a loop and surprisingly this error does not reoccur at the same file but it reoccurs about 2 times in a loop with 70 >files.
Second:
When I manually click enter the RuntimeError 70: Permission Denied is thrown. But then the VBE goes into the debug mode and my Errorhandler is not handling it. The Errohandler is an infinitive loop as I am saving the file on a server and sometimes it fails to save. However when I manually tried to save the document (both, on the server and on the desktop) I got the same "PowerPoint-Error while saving the file." MsgBox.
Now my question is how do I either get rid of the saving error (which seems to be impossible) or how to surppress that error so that my macro does not stop everytime it occurs. As I would like to run the macro overnight.
In case anyone has experienced such a thing before and can help me out I would be very happy.
Thanks in advance
Follow these two things and you should be ok...
Mention the File Format while saving. For example pptPres.SaveAs strPath & strSave & ".pptx",24 '<~~ ppSaveAsOpenXMLPresentation. Also ensure the strPath & strSave & ".pptx" is the extact name of the fiel as you wanted it. Else tweak the variables accordingly.
Always add DoEvents after you issue the save(or save as) statement and before the .Close statement so Excel can get enough time to finish it's tasks.
Application.Wait suspends all Excel activity including execution of your macro. It's not so useful for fixing timing problems. When I want to add a little time so that the program can finish I/O or clipboard tasks, Sleep is a better option. First add a declaration:
Public Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As LongPtr)
Add error-trapping before the problem statement, including a statement to reset error handling after the problem:
TryCut1:
On Error GoTo TooFast1
objShape.TextFrame2.TextRange.Cut
On Error GoTo -1
Then add this for error handling. It waits for 10 milliseconds, then tries again:
TooFast1:
Sleep 10
Resume TryCut1
I have been working with this issue for days. I tried multiple different ways. I am attempting to append multiple files into an Access linked table or even a temp table or even into a single excel file. At first EVERY SINGLE TIME on the first attempt the program works perfectly, then after that it stops functioning for a period of time and then starts operating again. When it stop functioning I get an Subscript out of range run-time error 9.I open the proper excel file but for some reason it won't let me set it... How can it OPEN THE FILE but in the next line CAN'T FIND IT??? It is driving me insane, it works, it stops working, then it works again... Any advice or hints would be very much appreciated.
This is just one way I tried to do this but they all end the same.
i = 2 'i is created through another loop previously.
j = 0
With MyXL
.Visible = True
.DisplayAlerts = True
End With
Do
Set MyXL = CreateObject("Excel.Application")
MyXL.Workbooks.Open Directory & fileArray(j), Notify:=False, ReadOnly:=False 'Tried True previously but changed since i was making changes to the file.
Set wb = Workbooks(fileArray(j)) 'DING DING DING!!! WHY??? You WORKED before!!!
If wb.Sheets("Sheet1").Range("A1") = "System Status" Then
wb.Sheets("Sheet1").Range("A1") = "PO System Status"
wb.Save
End If
wb.Close True
Set wb = Nothing
MyXL.Quit
Set MyXL = Nothing
Set wb = Nothing
j = j + 1
Loop Until j = i
Previously I thought I wasn't closing the workbook correctly, but I have closed the MyXL and previous wb but i still run into the error. I was wondering if this is something that Access/vba just can't do in succession as well. I changed the ReadOnly to true and it still ends up the same way.
Set your workbook to the return value from the Open method:
Set wb = MyXL.Workbooks.Open(Directory & fileArray(j), Notify:=False, ReadOnly:=False)
If wb.Sheets("Sheet1").Range("A1") = "System Status" Then
wb.Sheets("Sheet1").Range("A1") = "PO System Status"
wb.Save
End If
You don't need to/shouldn't create a new Excel application instance for every file - set that up before you enter the loop, and close it once you're done updating files. Check your Task Manager and make sure you don't have a bunch of Excel instances hanging around.
I created a command button that auto saves the workbook into one of two file paths depending on info in the spreadsheet. This works fine for me but my colleague is gettting the follwing error everytime.
The method is extending the file path and adding \0BA1700 in this instance (this changes every time). This doesn't happen on my computer and the code works as it should. Here is the sub:
Private Sub CommandButton21_Click()
Dim pathUnder As String
Dim pathOver As String
Dim file As String
file = Range("D2").Value
pathUnder = "G:\Technical Services\LARGE CORPORATE UW\Full Insurance\FI Quote Spreadsheets (below 500)\"
pathOver = "G:\Technical Services\LARGE CORPORATE UW\Full Insurance\FI Quote Spreadsheets (above 500)\"
If Range("D4").Value = "" Or Range("D2").Value = "" Then
MsgBox ("Save Failed. Please ensure there are values in both cells D2 and D4")
Else
If Range("D4").Value >= 500 Then
ActiveWorkbook.SaveAs fileName:=pathOver & file & ".xlsm", FileFormat:=52
Else
ActiveWorkbook.SaveAs fileName:=pathUnder & file & ".xlsm", FileFormat:=52
End If
End If
End Sub
Help much appreciated.
Maybe some kind of exception? Are you sure nothing is currently using this file? Maybe you own program does?
Solved. My colleague's computer didn't have the G drive mapped to the correct server so remapped it and now working fine.
RESOLVED: I've accepted an answer below from Siddharth. I greatly appreciate everyone's help and I am amazed at the swift responses. I always learn something new when coming to this community for help, you guys are awesome.
Thanks for taking a moment to look at my message. I've put together a script (thanks in no small part to the great help here on SO) that takes an excel workbook and imports each worksheet to a separate table in an Access 2007 database. The script used to work fine on my PC but since a recent recovery from a hardware failure I haven't been able to get the script to run. To top it off, my client is getting different error messages than my own.
A large part of the issue has to do with my object references, when I have the Microsoft Excel 14 Object Library added as a reference from the tools menu, all works fine. However, the client has a different version of Office on their systems and wishes this app to be distributed to others who may have other versions of office installed. I've tried to implement some form of late binding, but I may not be approaching this correctly. Code is below:
edit: current code updated again, related to the accepted post from Siddharth below
Private Sub Command101_Click()
On Error GoTo Err_Command101_Click
' Set up excel object
Dim excelApp As Object
Set excelApp = CreateObject("Excel.Application")
' Set up workbook object
Dim excelbook As Object
' Set up file selection objects with parameters
Dim fileSelection As Object
Dim intNoOfSheets As Integer, intCounter As Integer
Dim strFilePath As String, strLastDataColumn As String
Dim strLastDataRow As String, strLastDataCell As String
' Prompt user with file open dialog
Set fileSelection = Application.FileDialog(1)
fileSelection.AllowMultiSelect = False
fileSelection.Show
' Get the selected file path
strFilePath = fileSelection.SelectedItems.Item(1)
' Open the workbook using the file path
Set excelbook = excelApp.Workbooks.Open(strFilePath)
' Get the number of worksheets
intNoOfSheets = excelbook.Worksheets.Count
' Set up object for current sheet name
Dim CurrSheetName As String
' Disable errors
DoCmd.SetWarnings False
' Loop through each sheet, adding data to the named table that matches the sheet
For intCounter = 1 To intNoOfSheets
excelbook.Worksheets(intCounter).Activate
DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel12, _
excelbook.Worksheets(intCounter).Name, strFilePath, True, _
excelbook.Worksheets(intCounter).Name & "!" & _
Replace(excelbook.Worksheets(intCounter).UsedRange.Address, "$", "")
Next
' Close Excel objects
excelbook.Close
excelApp.Quit
Set excelApp = Nothing
' Confirmation message
MsgBox "Data import Complete!", vbOKOnly, ""
DoCmd.SetWarnings True
Err_Command101_Click:
MsgBox Err.Description
End Sub
The failure seems to occur for the client on the line Set excelbook = excelApp.Workbooks.Add with this message:
My question is somewhat twofold:
a) Have I implemented late binding properly? and
b) How can I resolve this error while making sure to keep the script independent of a specific Office release?
Thanks for any help you can provide!
I believe the error is in this line
DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel12, ActiveSheet.Name, _
strFilePath, True, _
excelbook.Worksheets(intCounter).Name & "!" & _
Replace(excelbook.Worksheets(intCounter).UsedRange.Address, "$", "")
ActiveSheet.Name <+++++ This is causing the error.
Change that to excelbook.Worksheets(intCounter).Name
In Latebinding the code will not understand what Activesheet is
FOLLOWUP
You are getting a compile error because you did not add " _" at the end of the first line in DoCmd.TransferSpreadsheet
Copy the below code and paste it as it is in your code.
DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel12, _
excelbook.Worksheets(intCounter).Name, _
strFilePath, True, _
excelbook.Worksheets(intCounter).Name & "!" & _
Replace(excelbook.Worksheets(intCounter).UsedRange.Address, "$", "")
The Workbooks.Add method creates a new workbook. I don't understand why you're using that. Seems so me you want the user to select an existing workbook and open that, so you should use Workbooks.Open instead.
As to whether you have implemented late binding correctly, make sure your code module includes Option Explicit in its Declarations section (see Gord's answer for useful details), and then run Debug->Compile from the VB Editor's main menu. That effort will alert you to anything in your code (objects, properties, methods, constants) for which you need further work to make them compatible with late binding.
This is a big red flag:
DoCmd.SetWarnings False
Turning SetWarnings off can suppress error information which you need to help understand why your code isn't doing what you want. If you feel you must turn off SetWarnings in your production code, at least leave it on during development and debugging.
I'll add this just for reference... In the VBA IDE Window choose Tools > Options... and ensure that the "Require Variable Declaration" box has a check mark in it:
Then, check all of your existing modules to make sure that the very first two lines are
Option Compare Database
Option Explicit
The Option Explicit statement will be added to any new Modules that you create, but you'll need to add it yourself for any existing Modules.