VBA PowerPoint 检查 FileNma 是否已经存在

Question

我想做的是检查文件名是否已经存在，然后进行修改。我尝试了几种方法，但没有一种有效！你能帮我找到解决办法吗？

这是我用三种不同的方法写的：

Private Sub CommandButton21_Click()
Dim lRetVal As Long
Dim ObjFso As Object
Dim CheckExists As Boolean

Todate = DateValue(Now)
oldWeekDay = Weekday(Todate)
Select Case oldWeekDay

Case 1
NewFileName = "PT PM Weekly " & Format(Date + 4, "yyyymmdd")
Case 2
NewFileName = "PT PM Weekly " & Format(Date + 3, "yyyymmdd")
Case 3
NewFileName = "PT PM Weekly " & Format(Date + 2, "yyyymmdd")
Case 4
NewFileName = "PT PM Weekly " & Format(Date + 1, "yyyymmdd")
Case 5
NewFileName = "PT PM Weekly " & Format(Date, "yyyymmdd")
Case 6
NewFileName = "PT PM Weekly " & Format(Date + 6, "yyyymmdd")
Case 7
NewFileName = "PT PM Weekly " & Format(Date + 5, "yyyymmdd")

End Select
OwnPathName = Application.ActivePresentation.Path
FullFileName = OwnPathName & "\" & NewFileName
MsgBox OwnPathName
MsgBox FullFileName
'-------------------------------------------------------------------
'lRetVal = Application.Presentations.Open(FullFileName)
'If lRetVal <> HFILE_ERROR Then
'  MsgBox "Modification already done"
'------------------------------------------------------------------
   'If Dir(FullFileName) <> "" Then
   'MsgBox "Modification already done"

'-------------------------------------------------------------------
        'Set ObjFso = CreateObject("PowerPoint.Application")
        'CheckExists = ObjFso.FileExists(FullFileName)
        'If CheckExists = True Then
        'MsgBox "Modification already done"
Else
deleteTextBox
AllBlackAndDate
LastModifiedDate
SaveAllPresentations (FullFileName)
End If
End Sub

感谢您的帮助！

Answer 1

尝试下面的代码，它将检查 PowerPoint 演示文稿的 NewFileName 是否已存在于同一文件夹中，如果存在，将调出您想要的 MsgBox。

Private Sub CommandButton21_Click()

Dim NewFileName             As String
Dim OwnPathName             As String

oldWeekDay = Weekday(Now)

Select Case oldWeekDay

    Case 1
        NewFileName = "PT PM Weekly " & Format(Date + 4, "yyyymmdd")
    Case 2
        NewFileName = "PT PM Weekly " & Format(Date + 3, "yyyymmdd")
    Case 3
        NewFileName = "PT PM Weekly " & Format(Date + 2, "yyyymmdd")
    Case 4
        NewFileName = "PT PM Weekly " & Format(Date + 1, "yyyymmdd")
    Case 5
        NewFileName = "PT PM Weekly " & Format(Date, "yyyymmdd")
    Case 6
        NewFileName = "PT PM Weekly " & Format(Date + 6, "yyyymmdd")
    Case 7
        NewFileName = "PT PM Weekly " & Format(Date + 5, "yyyymmdd")

End Select

OwnPathName = ActivePresentation.Path
FullFileName = OwnPathName & "\" & NewFileName

' for debug only (can remove it later)
MsgBox OwnPathName
MsgBox FullFileName


Dim StrFile             As String
Dim FileFound           As Boolean

FileFound = False
' look for all types of PowerPoint files only (filter only to PowerPoint files to save time)
StrFile = Dir(OwnPathName & "\*ppt*")

Do While Len(StrFile) > 0
    If InStr(StrFile, NewFileName) > 0 Then
        FileFound = True
        Exit Do
    End If
    StrFile = Dir
Loop

If FileFound Then
    MsgBox "Modification already done"
Else
    ' do something .... your logics

End If

End Sub

VBA PowerPoint 检查 FileNma 是否已经存在

VBA PowerPoint to check if a FileNma already exist

macros

powerpoint

vba