0

Trying to write a code where I loop through a subfolder, update and rename a powerpoint with a new name, and then move the old one to an Archive folder. The first 2 parts work, but the last part does not. I end up with both the old file and the new one in the original path. What am I doing wrong?

If needed, the "update" is basically copying one slide from a different master deck and copying it into the powerpoint.

Sub CopyDepositModelingWSCards()

    Dim AreaReport As Presentation, oSld As Slide
    Dim MasterPPT As Presentation
    Set MasterPPT = ActivePresentation
    Dim MyFile As String
    Dim fso As New FileSystemObject
    
    filepath = [path]
   
    Set f = CreateObject("Scripting.Filesystemobject").GetFolder(filepath)
     
    i = 44 'used master ppt slide index
    
        For Each subFolder In f.subfolders
            Debug.Print subFolder.Name
            
                 'loop files in subfolders
                If subFolder Like "*Completed*" Then
                    'Do nothing
                ElseIf subFolder Like "*Archive*" Then
                    'Do nothing
                Else
                    
                    For Each f In subFolder.Files
                        
                        If LCase(f.Name) Like "*.ppt*" Then
                            Debug.Print , f.Path
                        
                        Set AreaReport = Presentations.Open(f, WithWindow:=msoTrue)
                        
                        'get file name without file extension
                        currentFileName = Left(Application.ActivePresentation.Name, Len(Application.ActivePresentation.Name) - 5)
                        
                        'set new file name with the current date
                        newFileName = ActivePresentation.Path & "\" & Left(currentFileName, Len(currentFileName) - 8) & Format(Now(), "YYYYMMDD")
                        
                            With Application.ActivePresentation
                                
                                SourceFileName = ActivePresentation.FullName
                                DestinFolder = ActivePresentation.Path & "\Archive\"
                                
                                'Debug.Print (SourceFileName)
                                'Debug.Print (DestinFolder)
                                       
                                .SaveAs newFileName
                            
                                MasterPPT.Slides(i).Copy
                                AreaReport.Slides.Paste (1)
                                AreaReport.Slides.Item(1).Design = _
                                    MasterPPT.Slides.Item(2).Design
                                    
                                AreaReport.Slides(2).Delete
                                
                                .SaveAs newFileName
                                
                                On Error Resume Next
                                fso.MoveFile Source:=SourceFileName, Destination:=DestinFolder
                                
                                'PowerPoint.Application.Presentations(SourceFileName).Close
                                fso.MoveFile Source:=SourceFileName, Destination:=DestinFolder
                                
                            End With
                            AreaReport.Close
                        End If
                    Next f
                End If
            i = i + 1
        Next subFolder
    
    MsgBox ("Complete")
End Sub
xiaomao
  • 5
  • 2
  • `On Error Resume Next` is probably hiding an error (most likely due to you trying to move the same file twice) – Tim Williams Jul 14 '23 at 16:33
  • Good call.. Totally forgot I had that there. It's giving me Run-time error '76': Path not found... when the path is definitely there. – xiaomao Jul 14 '23 at 17:27
  • Does the "Archive" folder already exist? See also - https://learn.microsoft.com/en-us/office/vba/language/reference/user-interface-help/movefile-method#:~:text=If%20destination%20is%20a%20directory%2C%20an%20error%20occurs. "If destination is a directory, an error occurs." – Tim Williams Jul 14 '23 at 17:46
  • Try `fso.MoveFile source:=f.path, Destination:=f.parentfolder & "\Archive\" & f.Name` – Tim Williams Jul 14 '23 at 18:03
  • that worked! wow! what's the difference? is it the f.Name instead of just ending at Archive? – xiaomao Jul 14 '23 at 18:41
  • You need to pass the full path to destination (including the file name) – Tim Williams Jul 14 '23 at 19:53

1 Answers1

0

You need to pass the full path - including the file name - to Destination, so this should work:

fso.MoveFile source:=f.path, Destination:=f.parentfolder & "\Archive\" & f.Name

Also don't forget fso has handy methods like GetBaseName and GetExtensionName which can replace some of that Left/Right/Mid code.

Tim Williams
  • 154,628
  • 8
  • 97
  • 125