I like to open a PowerPoint file from Excel.
I have tried it several times but it does not work.
The Problem sounds similar to these:
not able to Open Powerpoint using VBA
The only difference is, I get another error code:
'Laufzeitfehler '-2147024894 (80070002)':
Die Methode 'Open' für das Objekt 'Presentations' ist fehlgeschlagen.
I checked that the Microsoft PowerPoint 16.0 Object Library ist activated. And i checked the filepath several times.
Does anyone have an idea what the mistake can be?
Sub sub_powerpoint_test()
Dim ObjPPT As PowerPoint.Application
Dim ObjPresentation As PowerPoint.Presentation
Dim str_FileName_PPTX As String
Set ObjPPT = CreateObject("PowerPoint.Application")
ObjPPT.Visible = msoCTrue
'Get PPT Filename
If Len(Dir(ThisWorkbook.Path & "\*.pptx")) = 0 Then
MsgBox "PPTX file does NOT exist in this folder."
Else
str_FileName_PPTX = ThisWorkbook.Path & Dir(ThisWorkbook.Path & "\*.pptx")
Debug.Print str_FileName_PPTX
End If
Set ObjPresentation = ObjPPT.Presentations.Open(str_FileName_PPTX, Untitled:=msoTrue)
End Sub
The error occures in the Open line at the end.
I found the solution. The Problem was a missing "\" in the path.
The corrected code is:
If Len(Dir(ThisWorkbook.Path & "\*.pptx")) = 0 Then
MsgBox "PPTX file does NOT exist in this folder."
Else
str_FileName_PPTX = ThisWorkbook.Path & "\" & Dir(ThisWorkbook.Path & "\*.pptx")
Debug.Print str_FileName_PPTX
End If
Related
I was trying to use VBA to open another PPT and copy the 2 pages in it to the end of my current ppt.
I used Presentation.Open to open the ppt, however, it gave me an error at this line: Presentations.Open (ppt_SourceFile): Run-time error '-2147467259(80004005)': Method 'Open' of object 'Presentations' failed.
Can anyone please help me understand what was wrong?
Thank you in advance!!!
Sub copyFromPPT()
Dim slideCount As Integer
Dim sourcePath as string, ppt_SourceFile As String, pptSource As String, thisPresentation As String
'Copy and paste the pages at the end
thisPresentation = ActivePresentation.Name
slideCount = ActivePresentation.Slides.Count
'Open ppt file
sourcePath = ActivePresentation.Path
ppt_SourceFile = sourcePath & "\CFTC Reg Reporting*.pptx"
Presentations.Open (ppt_SourceFile)
pptSource = ActivePresentation.Name
'Copy the 1st slide of source ppt to end of this slide
ActivePresentation.Slides(1).Copy
Presentations(thisPresentation).Slides.paste
slideCount = ActivePresentation.Slides.Count
'Copy the 2nd slide of source ppt to end of this slide
Presentations(pptSource).Slides(2).Copy
Presentations(thisPresentation).Slides.paste
'Close source ppt file
Presentations(pptSource).Close
ActivePresentation.Save
End Sub
If there's only one matching file in the folder you can do something like this:
Sub copyFromPPT()
Dim thisPres As Presentation, sourcePres As Presentation, f
Dim sourcePath As String
Set thisPres = ActivePresentation
sourcePath = thisPres.Path & "\"
f = Dir(sourcePath & "CFTC Reg Reporting*.pptx") 'see if there's a file...
If Len(f) = 0 Then
MsgBox "No matching file found", vbExclamation
Exit Sub
End If
Set sourcePres = Presentations.Open(sourcePath & f) 'Open ppt file and get a reference
sourcePres.Slides(1).Copy
thisPres.Slides.Paste 'you can add a paste position here, or leave blank to paste to the end...
sourcePres.Slides(2).Copy
thisPres.Slides.Paste
sourcePres.Close
thisPres.Save
End Sub
I have a PowerPoint with a couple macros: one that allows you to load some data from a Word, and another one that exports the PowerPoint to the same location where the Word was. This is the latter:
Sub export()
Dim dlgSaveAs As FileDialog
Dim strMyFile As String
Dim ppPres As Presentation
Set dlgSaveAs = Application.FileDialog(Type:=msoFileDialogSaveAs)
With dlgSaveAs
.InitialFileName = path & "Exported without macros - " & company & " (((insert date)))"
If .Show = -1 Then
strMyFile = .SelectedItems(1)
'MsgBox strMyFile
ActivePresentation.SaveAs strMyFile, 1
'-- save your file to strMyFile here
Else
'MsgBox "No file selected."
'-- The user pressed Cancel.
End If
End With
Set dlgSaveAs = Nothing
End Sub
To be honest, I didn´t wrote this code. I found it months ago and adapted it and I dont know how it really works.
The issue is that when the 'Save As' FileDialog opens, the file extension seems to be ok:
But after pressing 'save' the file gets saved as a .ppt:
Any idea how to fix this?
Change this:
ActivePresentation.SaveAs strMyFile, 1
to this:
ActivePresentation.SaveAs strMyFile, 24
or to
ActivePresentation.SaveAs strMyFile, ppSaveAsOpenXMLPresentation
First of all, thanks for all the answers I have gotten on my previous questions, you really helped me out. The excel has evolved and now I'm ready to open different excel sheets in the background and print out different sheets on different printers. However, I'm working on a network that changes it's settings (which appear to change randomly).
Sub Client_Overzetten()
Application.ScreenUpdating = False
'
Workbooks.Open ("G:\Moe\WD\Planning&Control\Client.xlsm")
....etc...
However, if my colleague would try to open this file, he will get an error, as the same document has a different link (due to access restrictions).
His link is
G:\WD\Planning&Control\Client.xlsm")
Is there a formula to go to another location the moment it hits an error? Something like:
Sub Kids_II_Overzetten()
'
Application.ScreenUpdating = False
'
Workbooks.Open ("G:\Moe\WD\Planning&Control\Client.xlsm")
If error, then
Workbooks.Open ("G:\WD\Planning&Control\Client.xlsm")
I have the same problem with the serverports of the printer, these ports change randomly
ActivePrinter = "\\w8vvmprint01\Moecombi07 op Ne07:"
However, the next day it can be the same, or can be a different port
ActivePrinter = "\\w8vvmprint01\Moecombi07 op Ne03:"
With the solving of the problem of my first question, can I answer my second question as well (on error, go to the next line)?
Thanks in advance :)
For the network locations you'll need to use the UNC path which will not change rather than the mapped path which can change on different computers.
To find your UNC paths open a command prompt (Run - cmd.exe) and type in net use.
The resulting table will give the local and remote names of the drives- just replace your mapped (local) connection with the remote one.
For example,
G:\Moe\WD\Planning&Control\Client.xlsm
may become
\\MyServerName\Moe\WD\Planning&Control\Client.xlsm
Edit - the server name can also be found on the file explorer - windows key + E to open.
It will appear in the folder name as Moe on 'MyServerName' (G:)
To only use the mapped locations you could try:
Sub Test()
Dim wrkBk As Workbook
Dim sFileLocation As String
On Error GoTo ERROR_HANDLER
sFileLocation = "S:\Bartrup-CookD_SomeLocation\New Microsoft Excel Worksheet.xlsx"
Set wrkBk = Workbooks.Open(sFileLocation)
On Error GoTo 0
Exit Sub
ERROR_HANDLER:
Select Case Err.Number
Case 1004 'Microsoft Excel cannot access the file
sFileLocation = "S:\Bartrup-CookD\New Microsoft Excel Worksheet.xlsx"
Resume
Case Else
MsgBox "Error " & Err.Number & vbCr & _
" (" & Err.Description & ") in procedure Test."
Err.Clear
Application.EnableEvents = True
End Select
End Sub
or ask the user to select the correct file:
Public Sub AskForFile()
Dim vFile As Variant
Dim wrkBk As Workbook
vFile = GetFile("S:\Bartrup-CookD\")
If vFile <> "" Then
Set wrkBk = Workbooks.Open(vFile)
End If
End Sub
Public Function GetFile(Optional startFolder As Variant = -1) As Variant
Dim fle As FileDialog
Dim vItem As Variant
Set fle = Application.FileDialog(msoFileDialogFilePicker)
With fle
.Title = "Select a File"
.AllowMultiSelect = False
.Filters.Add "Excel Files", "*.xls*", 1
If startFolder = -1 Then
.InitialFileName = Application.DefaultFilePath
Else
If Right(startFolder, 1) <> "\" Then
.InitialFileName = startFolder & "\"
Else
.InitialFileName = startFolder
End If
End If
If .Show <> -1 Then GoTo NextCode
vItem = .SelectedItems(1)
End With
NextCode:
GetFile = vItem
Set fle = Nothing
End Function
I am creating a script that copies slides from various other .pptx files into a Master PowerPoint, but if one of the files is opened by another User at the same time the macro executes I receive an 80004005 error. My script is as follows:
Public Sub Update()
Dim PPTApp As Object
Dim PPT As Object
Dim MasterPPT As Presentation
Dim Total As Integer
Dim FSO As New Scripting.FileSystemObject
Dim Folder As Scripting.Folder
Dim SubFolder As Scripting.Folder
Dim File As Scripting.File
Set MasterPPT = Presentations("Combined Staff Agenda Template.pptm")
Total = MasterPPT.Slides.Count
Set PPTApp = CreateObject("PowerPoint.Application")
' Sets the first ComboBox destination folder
Set Folder = FSO.GetFolder("O:\org\acle\Common\PE_SHARE\Technical Staff Meeting Agendas\Individual Slides\" & Order_UserForm.comboFirst.Value)
For Each SubFolder In Folder.SubFolders
For Each File In SubFolder.Files
' Copies and pastes all slides for each file
Set PPT = PPTApp.Presentations.Open(File.Path, ReadOnly:=msoTrue, WithWindow:=msoFalse)
PPT.Slides.Range.Copy
MasterPPT.Slides.Paste (Total)
PPT.Close
Total = MasterPPT.Slides.Count
Next File
Next SubFolder
The For Each loop is repeated twice for two more folders, and then the sub routine ends. The folder system is organized as follows: Parent Directory ("Technical Staff Meeting Agendas") > "Individual Slides" > Three (3) Department Folders > Individual User Folders with a .pptx file in each. Any workaround for accessing the File.Path if it is already opened?
Completely untested, but let's try something like this (assuming you're getting an error on Presentations.Open. I added an error-handling block around this method call, and based on the documentation (here) it looks like the .Open method's Untitled argument is equivalent to creating a copy of the file.
If that doesn't work, let me know. I can revise to explicitly create and open a copy of the file and open that, instead.
UPDATE Since the Untitled property didn't work, let's try explicitly creating a copy of the file. I did not include any "cleanup" code to remove the copied versions.
Public Sub Update()
Dim PPTApp As Object
Dim PPT As Object
Dim MasterPPT As Presentation
Dim Total As Integer
Dim FSO As New Scripting.FileSystemObject
Dim Folder As Scripting.Folder
Dim SubFolder As Scripting.Folder
Dim File As Scripting.File
Set MasterPPT = Presentations("Combined Staff Agenda Template.pptm")
Total = MasterPPT.Slides.Count
Set PPTApp = CreateObject("PowerPoint.Application")
' Sets the first ComboBox destination folder
Set Folder = FSO.GetFolder("O:\org\acle\Common\PE_SHARE\Technical Staff Meeting Agendas\Individual Slides\" & Order_UserForm.comboFirst.Value)
For Each SubFolder In Folder.SubFolders
For Each File In SubFolder.Files
' Copies and pastes all slides for each file
On Error GoTo FileInUseError
Set PPT = PPTApp.Presentations.Open(File.Path, ReadOnly:=msoTrue, WithWindow:=msoFalse)
On Error GoTo 0
PPT.Slides.Range.Copy
MasterPPT.Slides.Paste (Total)
PPT.Close
Total = MasterPPT.Slides.Count
Next File
Next SubFolder
'## It's important to put this before your error-handling block:
Exit Sub
'## Error handling:
Err.Clear
'## First attempt, did not work as expected
'Set PPT = PPTApp.Presentations.Open(File.Path, ReadOnly:=msoTrue, Untitled:=msoTrue, WithWindow:=msoFalse)
'## Second attempt. You will need to add some logic to remove these files or do it manually.
Dim copyPath as String
copyPath = Replace(File.Path, File.Name, "Copy of " & File.Name)
FSO.CopyFile File.Path, copyPath, True
Set PPT = PPTApp.Presentations.Open(copyPath)
Resume Next
End Sub
Update 2
Other things you could try (not likely to work, but you should try them anyways):
I notice that this code is executing from within PowerPoint, so one thing that doesn't make sense is the: Set PPTApp = CreateObject("PowerPoint.Application"). You're already running an instance of PPT, and only one instance of PPT runs (unlike Excel which can have multiple instances). So get rid of that line entirely.
'Set PPTApp = CreateObject("PowerPoint.Application")
Then also you can get rid of the variable PPTApp. I notice you use a combination of early- and late-binding for your PowerPoint Object Variables. That doesn't really make sense and while I wouldn't expect that to cause any errors, you never know.
'Dim PPTApp as Object 'PowerPoint.Application '## This is unnecessary!!
Dim PPT as Presentation
Dim MasterPPT as Presentation
If all else fails, open the new file WithWindow=msoTrue and step through the code line by line using F8...
UPDATE 3
While I am not able to test a file that is locked/in-use by another user, I was able to test what happens if I have a file that is in use by myself. I use the following code and identify that the Files iteration will eventually encounter the lock/tmp version of the file, beginning with "~" tilde character. These are ordinarily hidden files, but FSO is picking them up in the iteration anyways.
Aside from that, I encounter similar errors if the file is not a valid PPT filetype (PPT, PPTX, PPTM, XML, etc.). I used the following code which prints a log of errors in the Immediate window (and informs you with MsgBox prompt) if there are errors.
Sub Test()
Dim MasterPPT As Presentation
Dim PPT As Presentation
Dim Total As Integer
Dim FSO As Object
Dim Folder As Object
Dim SubFolder As Object
Dim File As Object
Dim errMsg$
Dim copyPath$
Set MasterPPT = ActivePresentation '## Modify as needed.
Total = MasterPPT.Slides.Count
Set FSO = CreateObject("Scripting.FileSystemObject")
' Sets the first ComboBox destination folder // MODIFY AS NEEDED
Set Folder = FSO.GetFolder("C:\Users\david_zemens\Desktop\CHARTING STANDARDS")
For Each SubFolder In Folder.SubFolders
For Each File In SubFolder.Files
' Copies and pastes all slides for each file
On Error GoTo FileInUseError:
' Make sure it's a PPT file:
If File.Type Like "Microsoft PowerPoint*" Then
10:
Set PPT = Presentations.Open(File.Path, ReadOnly:=msoTrue, WithWindow:=msoFalse)
20:
PPT.Slides.Range.Copy
30:
MasterPPT.Slides.Paste (Total)
PPT.Close
End If
On Error GoTo 0
Total = MasterPPT.Slides.Count
NextFile:
Next File
Next SubFolder
'## It's important to put this before your error-handling block:
Set FSO = Nothing
Set Folder = Nothing
Set SubFolder = Nothing
Set File = Nothing
Exit Sub
FileInUseError:
'## Error handling:
'## Display information about the error
errMsg = "Error No.: " & Err.Number & vbCrLf
errMsg = errMsg & "Description: " & Err.Description & vbCrLf
errMsg = errMsg & "At line #: " & Erl & vbCrLf
errMsg = errMsg & "File.Name: " & File.Name
Debug.Print errMsg & vbCrLf
MsgBox errMsg, vbInformation, "Error!"
Err.Clear
Resume NextFile
End Sub
I created a simple macro to put an HTML widget from Weather.com in to a PowerPoint slide.
It is not event-based, but ActionButtons call the ConnectWidget subroutine, when navigating to the slide. That's working fine, but you will notice that I have only been able to get this to work by first deleting the existing WebBrowser shape, and then re-creating it.
I had to do this, ultimately, because any method call from wb after the .Navigate, I get an Automation Error/Unspecified Error, or Method unavailable error. So for example, I could not call on wb.Refresh when moving back and forth between slides, without first deleting the browser shape entirely, and recreating it.
There is probably something obvious that I am overlooking -- any thoughts to what might be causing those errors? Google turned up nothing really useful in resolving the problem.
Sub ConnectWidget()
Dim sld As Slide
Dim pres As Presentation
Dim shp As Shape
Dim wb As IWebBrowser2
Dim fname As String: fname = "c:" & Environ("homepath") & "\widget2.html"
Set pres = ActivePresentation
Set sld = pres.Slides(2)
On Error Resume Next
sld.Shapes("weatherwidget").Delete
On Error GoTo 0
If Len(Dir(fname)) = 0 Then CreateHTML fname
Set shp = sld.Shapes.AddOLEObject(100, 200, 200, 150, _
"Shell.Explorer.2")
shp.Name = "weatherwidget"
Set wb = sld.Shapes("weatherwidget").OLEFormat.Object
With wb
.Navigate (fname)
End With
' wb.Refresh '## UNCOMMENT THIS LINE AND YOU WILL GET AN ERROR
Set wb = Nothing
On Error Resume Next
Kill fname
On Error GoTo 0
End Sub
Private Sub CreateHTML(fileName$)
'Createsa plaintext HTML file that IWebBrowser2 can navigate
'<script type="text/javascript" src="http://voap.weather.com/weather/oap/90210?template=GENXH&par=3000000007&unit=0&key=twciweatherwidget"></script>
Dim htmlTxt As String
Dim fs As Object
Dim a As Object
htmlTxt = "<script type=" & Chr(34) & "text/javascript" & Chr(34) & "src=" & Chr(34) & _
"http://voap.weather.com/weather/oap/90210?template=GENXH&par=3000000007&unit=0&key=twciweatherwidget" _
& Chr(34) & "></script>"
Set fs = CreateObject("Scripting.FileSystemObject")
Set a = fs.CreateTextFile(fileName, True)
a.WriteLine htmlTxt
a.Close
End Sub
Here is one such error. Note that I have no option to Debug the error. All I can surmise from stepping over the code is that any method call after the .Navigate will result in this error.