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
Related
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.
edit2: I think I identified the problem: Another user had the file open, but when I manually opened it he must have had it closed. Now I wonder how to avoid this issue because I don't the macro to fail, much less so with some cryptic error message. I would be happy with read-only, but apparently it doesn't give me that option. Do I have to open every file read-only by default to not run into this issue again?
I've been working on some code and all of a sudden, a very basic line gets me an error message: "Run time error -2147467529 (80004005): Method 'Open' of object 'Presentations' failed. I recreated the problem in this piece of code:
Dim PowerPointApp As PowerPoint.Application
Dim myPresentation As PowerPoint.Presentation
Sub MReport()
Dim DestinationTemplate As String, DestinationAmp As String
Dim PPAmp As PowerPoint.Presentation
Dim AmpName As String, PathAmp As String
DestinationTemplate = "G:\MReport\MReportTemplate.pptm"
PathAmp = "G:\MReport\Amp\MReportAmp\"
AmpName = Dir(PathAmp & "Amp*long*.*")
DestinationAmp = PathAmp & AmpName
Debug.Print DestinationAmp
Set PowerPointApp = New PowerPoint.Application
Set myPresentation = PowerPointApp.Presentations.Open(DestinationTemplate) 'works
Application.DisplayAlerts = False 'doesn't help
Set PPAmp = PowerPointApp.Presentations.Open(DestinationAmp) '<-- error
Application.DisplayAlerts = True
End Sub
The error occurs in the line Set PPAmp = PowerPointApp.Presentations.Open(DestinationAmp). It worked literally dozens of times before. Then I rearranged some code unrelated to this PowerPoint file and shifted it into separate procedures and the error happened. The error now happens in the new, re-arranged file and in the old one, which successfully ran for days.
I tried restarting my computer, MS PowerPoint 16.0 Object Library is also checked. The Debug.Print statement gives me the correct path, I can copy it into the file explorer and the right presentation opens.
The code is written in Excel, but when I copied it into PowerPoint I got the same error. I also tried declaring all the PowerPoint-related variables (PowerPointApp, myPresentation, PPAmp) as Object and then use Set PowerPointApp = CreateObject("PowerPoint.Application") without success.
edit: Typing PowerPointApp.Presentations.Open("Filepath") gives me the same error (I think): "Run time error '-2147467259 (80004005)': Automation error. Unknown error."
I'm working on a program using both Matlab and Excel. Excel gives its data to Matlab with a text file and then, once Matlab has finished its analysis, it creates a text file to be read by Excel.
In my vision of the program, I would like to have only one sub to do everything. Therefore, I wanted to put the sub on hold to wait Matlab until the file is ready. There comes my problem, because there's no file before Matlab finishes, trying to open the file will result in an error.
I tried to use the error handler to make a loop but it appears that VBA doesn't allow it.
Here's my test code:
Sub Test()
Fichier = "'filepath'\file.txt"
IndexFichier = FreeFile()
1:
On Error GoTo expected
Open Fichier For Input As #IndexFichier
Close #IndexFichier
Exit Sub
expected:
Err.Clear
Close #IndexFichier 'Don't know if useful'
GoTo 1
End Sub
I expected the code to loop between "1" and "expected" but after one loop vba breaks on its own with the expected error "file not found". Does anyone know if there's a possibility to loop on errors or do I have to make another sub?
You don't need to wait for an error, this is what you are looking for:
Ruta = wb.Path & "\"
Exportar = Ruta & "datos" & Servicio & ".txt"
FindIt = Dir(Exportar)
While Len(FindIt) = 0
FindIt = Dir(Exportar)
Wend
You can have the code check to see if your path exists or not. If not, have it wait.
Do While Dir(Fichier) = ""
Application.Wait(Now() + TimeValue("00:00:10"))
Loop
I have been searching for a way to distribute macros to my tech illiterate office in the simplest way I can.
From my research, saving the Macros into a .xlam add-in would seem to be headed in the right direction.
Is it also possible to set up a custom ribbon tab in this manner?
Thus far I have failed to find any guides and our office security may also block certain avenues.
Edit:
Using W-Hit's excellent solution, and setting up the folder structure as indicated, it definitely helps make deploying an update much easier with the DeployAddIn subroutine.
I also found it useful to put the DeployAddIn and InstallAddin subroutines into a custom ribbon tab of their own!
I ran into a problem with the InstallAddin subroutine however: how to format the XML text in VBA without running into syntax errors.
I discovered that Each Element must have mso at the start e.g. <button> becomes <mso:button> and each "speech marked section" in a line must have ""double speech marks".
Perhaps the easiest way to use this install function is to save and edit the code into an active file, then open C:\Users[username]\AppData\Local\Microsoft\Office\Excel.officeUI in Notepad++. Then simply perform a find and replace to add in the extra quotation marks and paste it into the ribbonXML = "insert your text here" section of the code, ensuring it is encapsulated by the final speech marks to mark the entire section as a text string.
I might also look into adding extra functionality here... having an inputbox or userform that allows you to paste the code in at this point rather than have you enter the VBA editor to paste it in.
I currently do this, and it's a somewhat in depth process to setup, but runs smoothly once it is.
1st step is to create a folder structure with testing and production copies of your .xlam files that you are the admin for.
2nd, in the production folder, right click all .xlam files and set the attributes in the properties to Read-only. If you don't you'll never be able to update the addin if anyone else is in it.
3rd, when you make updates to the code in the testing file, just replace the production file with the updated file, and change to Read-only again. Users will only have to close all instances of excel and reopen to have the most up-to-date copy of the add-in.
Below is an admin add-in I use to move testing files to production.
Sub DeployAddIn()
'Author : Ken Puls (www.excelguru.ca)
'Macro Purpose: To deploy finished/updated add-in to a network
' location as a read only file
Dim strAddinDevelopmentPath As String
Dim strAddinPublicPath As String
Dim FSO As New FileSystemObject
'Set development path
ChDrive "R:"
ChDir "R:\addins\PROJECTS"
strAddinDevelopmentPath = Application.GetOpenFilename()
If strAddinDevelopmentPath = "False" Then
Exit Sub
ElseIf InStr(strAddinDevelopmentPath, "\PRODUCTION\") > 1 Then
If MsgBox("You've Selected a Production File To Replace a Production File. Would You Like To Continue Anyway?", vbYesNo) = vbNo Then
Exit Sub
End If
End If
'Get Desitination path
strAddinPublicPath = Replace(strAddinDevelopmentPath, "TESTING", "PRODUCTION")
'Create dir if it doesn't exist
On Error Resume Next
MkDir Left(strAddinPublicPath, InStrRev(strAddinPublicPath, "\") - 1)
On Error GoTo 0
'Turn off alert regarding overwriting existing files
Application.DisplayAlerts = False
'overwrite existing file
On Error Resume Next
SetAttr strAddinPublicPath, vbNormal
On Error GoTo 0
FSO.CopyFile strAddinDevelopmentPath, strAddinPublicPath, True
SetAttr strAddinPublicPath, vbReadOnly
'Resume alerts
Application.DisplayAlerts = True
End Sub
4th, I've also written a macro to change the custom ribbon. The below link, in addition Ron deBruin's site is useful. https://grishagin.com/vba/2017/01/11/automatic-excel-addin-installation.html
Code to automate addin install after you get the right text from the officeUI file
Sub InstallAddin()
'Adapted from https://grishagin.com/vba/2017/01/11/automatic-excel-addin-installation.html
Dim eai As Excel.AddIn
Dim alreadyinstalled As Boolean
Dim ribbonXML As String
'check if already installed
For Each eai In Application.AddIns
If eai.Name = "Main addin.xlam" Then
eai.Installed = False
Exit For
End If
Next
'add and install the addin
Set eai = Application.AddIns.Add("path to Main addin.xlam", False)
eai.Installed = True
'append quick access ribbon xml to add button
ClearCustRibbon
LoadNewRibbon
'have to close addin for it to load properly the first time
Workbooks("Main addin.xlam").Close
End Sub
Sub ClearCustRibbon()
'https://social.msdn.microsoft.com/Forums/vstudio/en-US/abddbdc1-7a24-4664-a6ff-170d787baa5b/qat-changes-lost-when-using-xml-to-modify-ribbon-excel-2016-2016?forum=exceldev
Dim hFile As Long
Dim ribbonXMLString As String
hFile = FreeFile
OfficeUIFilePath = Environ("USERPROFILE") & "\AppData\Local\Microsoft\Office\Excel.officeUI"
ribbonXMLString = "<mso:customUI xmlns:mso=""http://schemas.microsoft.com/office/2009/07/customui"">" & _
"<mso:ribbon>" & _
"<mso:qat>" & _
"<mso:sharedControls>" & _
"</mso:sharedControls>" & _
"</mso:qat>" & _
"</mso:ribbon>" & _
"</mso:customUI>"
Open OfficeUIFilePath For Output Access Write As hFile
Print #hFile, ribbonXMLString
Close hFile
End Sub
Sub LoadNewRibbon()
Dim hFile As Long
hFile = FreeFile
OfficeUIFilePath = Environ("USERPROFILE") & "\AppData\Local\Microsoft\Office\Excel.officeUI"
ribbonXML = "your ribbon text here"
Open OfficeUIFilePath For Output Access Write As hFile
Print #hFile, ribbonXML
Close hFile
End Sub
***IMPORTANT---- If you install the addin manually, make sure you select no when prompted if you want the file saved to the local machine. If you save it to the local machine, it creates a local copy, and will never update if you make changes to the network copy or need to fix an error.
There are more tips, but you'll mostly need to adapt them to fit how you operate. Hope that helps.
Objective: I have a folder where multiple CSVs are dumped on my drive. These CSVs need to be converted to XLS files and saved (as XLS files) into the same, original folder. I have a code (pasted below) for it that works just fine, but...
Problem: A window pops up each time saying "Code execution has been interrupted," allowing me to Continue, End, or Debug. I can click Continue each time the window pops up (it pops up for each file that needs to be converted) and the script will work perfectly, but of course, I'd rather not have to click Continue potentially hundreds of times. The asterisk'd part of the code below is the part that is highlighted upon clicking Debug.
Sub Convert_CSV_XLS()
Dim wb As Workbook
Dim strFile As String, strDir As String
strDir = "xx:\xx\xx\xx\xx\xx\xx\xx\"
strFile = Dir(strDir & "*.csv")
Do While strFile <> ""
Set wb = Workbooks.Open(Filename:=strDir & "\" & strFile, Local:=True)
**wb.SaveAs Replace(wb.FullName, ".csv", ".xls"), 56**
wb.Close SaveChanges:=False
Set wb = Nothing
strFile = Dir
Loop
End Sub
Again - the code DOES work, it's just that the Debug window keeps popping up and I can't figure out what the issue is. By the way, I had to "xx" out the actual directory.
Thank you for any help!
Try : this
It may help solving your problem, I had one of those sticky debug boxes too for no reason at all and this line helped me.
Edit: Here's the code from the website above which solves the problem described.
Adding this line in the beggining of one's code will do the trick.
Application.EnableCancelKey = xlDisabled