none
[Powerpoint VBA] Loop through a file directory to check if the file exists, if it does increment the version number if not create the new file RRS feed

  • Question

  • Could someone please help me out with a way to loop through the directory of the current file and search for the file to see if it exists, if it does then count the number of files with version numbers already and increment the next number, if it does not exist then create the file like normal.

    Basically I have a vba macro that allows you to extract a slide pack from a 'master template' which they are all stored. The user clicks on the pack that they want and the pack gets extracted and saved out into that same directory. My problem is there is no version control or file protection setup. Could someone please help me work out how to do a loop and increment the version numbers.

    Option Explicit

    Public Sub CreatePack(control As IRibbonControl)

    Dim packName As String Dim Count As Integer Select Case control.Id Case "packbutton_B1" packName = "B1" Case "packbutton_B2" packName = "B2" Case "packbutton_TSD" packName = "TSD" End Select

    'Note: Attempt to remove characters that are not file-system friendly Dim Title As String If ActivePresentation.Slides(1).Shapes.Count >= 9 Then Title = Trim(ActivePresentation.Slides(1).Shapes(9).TextEffect.Text) If Title = "" Then MsgBox "Warning: A project title has not been entered on Slide 1." Else Title = "(Project Title Not Known)" MsgBox "The title slide has been removed, the project name cannot be detected." End If Title = Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Title, "/", ""), "\", ""), ":", ""), "*", ""), "<", ""), ">", ""), "|", ""), """", "")

    Dim path As String path = ActivePresentation.path

    If Len(Dir(path & "\" & packName & " Slide Pack - " & Title & ".pptx")) > 0 Then 'File exists

    ' If MsgBox("This will produce a pack in a separate PowerPoint file. Before extracting the pack make sure you have implemented a version number otherwise your changes maybe overwritten." & vbCrLf & vbCrLf & "Your current file will remain open, and any pending changes will not be automatically saved.", vbOKCancel, "Slide Manager - Create Pack") = vbOK Then

    MsgBox ("File exists, the file name version number will be incremented")

    CopySlidesToBlankPresentation packName

    Application.ActivePresentation.SaveAs path & "\" & packName & " Slide Pack - " & Title & Count + 1, ppSaveAsOpenXMLPresentation

    ActivePresentation.Save

    Else

    MsgBox ("This will produce a pack in a separate PowerPoint file." & vbCrLf & vbCrLf & "Your current file will remain open, and any pending changes will not be automatically saved")

    CopySlidesToBlankPresentation packName

    Application.ActivePresentation.SaveAs path & "\" & packName & " Slide Pack - " & Title, ppSaveAsOpenXMLPresentation

    ActivePresentation.Save

    End If

    End Sub

    Any help is greatly appreciated!

    Regards, Ben

    Friday, July 6, 2012 3:43 AM

Answers

  • Hello Ben,

    The example below is a relatively simple method. However, it has a caveat. It finds the next available version; not necessarily a number greater than the highest number already used. ie. If you have saved versions 1 to 6 and all versions still exist then the next one will be 7 which is great. But if say file number 4 has been deleted then as it iterates through then number 4 will not be found so that will be the new file name.

    Will this satisfy your needs or do you need to be sure that you have a number higher than the highest number already used? If the latter then I will have another look at it for you. It involves somewhat more complexity because need to save the matching entries into an array and sort so that the highest used number can be determined (or save each one if number greater than already saved). Also need to identify how may digits have been used by iterating backwards through the file name from the dot. (Can't just assume one or 2 digits.)

    Title = "My File"   'Used For testing

    i = 0   'Good programming practice to initialize in case has been used elsewhere

    Do
        If Len(Dir(Path & "\" & packName & " Slide Pack - " & Title & ".pptx")) = 0 Then
            'File does not exist so Exit Do and save with file name
            Exit Do
        Else
            i = i + 1
            Title = "My File" & i
        End If
    Loop

    'Save file code here using Title (which will have a version number appended only if required)


    Regards, OssieMac


    • Edited by OssieMac Friday, July 6, 2012 5:52 AM Typos edited
    • Marked as answer by Plunderedsouls Monday, July 23, 2012 6:27 AM
    Friday, July 6, 2012 5:50 AM