通过 excel VBA 打开 PowerPoint

Question

I want to open my PowerPoint file through excel VBA by only giving the extension of the file (. pptx). I have seen some codes but they require full name of the file to be given. Is it possible to do this? I am only keeping one PowerPoint file in my folder.

Answer 1

You can do something like this:

Sub Open_PPT()

    Dim PPTpath As String
    Dim PPTname As String

    Dim ThisExtension As String
    Dim temp As Variant

    temp = Split(ThisWorkbook.Name, ".")
    ThisExtension = temp(UBound(temp))

    PPTpath = Replace(ThisWorkbook.FullName, ThisExtension, "pptx")
    PPTname = Replace(ThisWorkbook.Name, ThisExtension, "pptx")

    Dim PPT As Object, PPPres As Object
    Set PPT = CreateObject("PowerPoint.Application")
    PPT.Visible = True

    PPT.Presentations.Open FileName:=PPTpath
    Set PPPres = PPT.Presentations(PPTname)
    'open PPT

    PPPres.Slides(1).Select
End Sub

I take the workbook's Name and split on "." and find the last element of the generated array - likely "xlsx". Then replace this with "pptx" so that we now have the full path like:

"C:\Users\name\Documents\Excel_name.pptx"

and the file name like "Excel_name.pptx" then we can create a PPT Application Object and open the file (I am assuming it exists, otherwise you need to open a new blank PPT and save it accordingly)

If your question is more like "can I find a.pptx file with any name in the same folder as the current folder (where the Excel is saved)" Then you are looking for something like:

Sub Find_and_open_PPT()

    On Error Resume Next

    Dim FSO As Object, fld As Object
    Dim fileExtn As String
    Dim PPTpath As String
    Dim PPTname As String

    fileExtn = ".pptx"

    Set FSO = CreateObject("Scripting.FileSystemObject")
    Set fsoFolder = FSO.GetFolder(ThisWorkbook.Path)

    For Each fsoFile In fsoFolder.Files 'check the files in the parent folder
        If Err.Number > 0 Then
            'MsgBox "error handling file, likely due to permission"
            Err.Clear
        End If
        If Right(fsoFile, Len(fileExtn)) = fileExtn Then
            'PPT found
            PPTpath = fsoFile
            PPTname = fsoFile.Name
            Exit For
        End If
    Next        

    Dim PPT As Object, PPPres As Object
    Set PPT = CreateObject("PowerPoint.Application")
    PPT.Visible = True

    PPT.Presentations.Open FileName:=PPTpath
    Set PPPres = PPT.Presentations(PPTname)
    'open PPT

    PPPres.Slides(1).Select        

End Sub

You could also modify this to find exactly the file name you are looking for or even a unix file match something like:

if fsoFile.Name like "example*.ppt*" then

Currently, the code stop looking once you find a file with the extension ".pptx":

If Right(fsoFile, Len(fileExtn)) = fileExtn Then