VBA FileNmaがすでに存在するかどうかを確認するPowerPoint

Question

私がしたいのは、ファイル名が既に存在しているかどうかを確認して自分の変更を行うことです。私はいくつかの方法を試みたが、誰も仕事をしなかった!! 解決策を見つけてもらえますか？

これは私が3つの異なる方法で書いたものです：

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