Powerpoint VBA function return not working

Question

This is driving me mad: I have a sub and a function in a powerpoint vba.

The sub starts by allowing me to select a dir. The function, called from the sub, finds a file in the dir. I want it as a function outside of the sub, as I will need to use it multiple times.

The sub is still under development, so doesn't do much, but works. The function works too if I give it something to do - like open the found file (ie uncomment that line in my code below) - but I can't for the life of me get it to return the filePath to the sub. Please help!

The sub:

Sub ManagementSummaryMerge()

   Dim folderPath As String

   'select dir
   Dim FldrPicker As FileDialog
   Set pptApp = CreateObject("PowerPoint.Application")
   pptApp.Visible = True


   'Retrieve Target Folder Path From User
   Set FldrPicker = Application.FileDialog(msoFileDialogFolderPicker)

   With FldrPicker
      .Title = "Select A Target Folder"
      .AllowMultiSelect = False

      If .Show <> -1 Then GoTo NextCode
      folderPath = .SelectedItems(1) & "\"
   End With

   'In Case of Cancel
   NextCode:
   folderPath = folderPath
   If folderPath = "" Then GoTo EndOfSub

   'set _Main <= string I want to look for
   Dim v As String
   v = "_Main"

   Dim fullFilePathIWantToSet As String

   'set value of fullFilePathIWantToSet from findFile function
   fullFilePathIWantToSet = findFile(folderPath, v) 

   'when I test, this MsgBox appears, but blank
   MsgBox fullFilePathIWantToSet

   'If I can get this working properly, I want to be able to do something like this:

   'objFSO.CopyFile fullFilePathIWantToSet, duplicateFilePath
   'Presentations.Open (duplicateFilePath)                            
   'numSlides = ActivePresentation.Slides.Count
   'etc


   EndOfSub:
   'let the sub end

End Sub

The function:

Function findFile(ByRef folderPath As String, ByVal v As String) As String

    Dim fileName As String
    Dim fullFilePath As String
    Dim duplicateFilePath As String
    Dim numFolders As Long
    Dim numSlides As Integer

    Dim folders() As String
    Dim i As Long

    If Right(folderPath, 1) <> "\" Then folderPath = folderPath & "\"
    ileName = Dir(folderPath & "*.*", vbDirectory)

    While Len(fileName) <> 0

        If Left(fileName, 1) <> "." Then

            fullFilePath = folderPath & fileName
            duplicateFilePath = folderPath & "duplicate " & fileName

            If (GetAttr(fullFilePath) And vbDirectory) = vbDirectory Then
                ReDim Preserve folders(0 To numFolders) As String
                folders(numFolders) = fullFilePath
                numFolders = numFolders + 1
            Else

                'if true, the it matches the string we are looking for
                If InStr(10, fullFilePath, v) > 0 Then

                    'if true, then it isn't in a dir called P/previous, which I want to avoid
                    If InStr(1, fullFilePath, "evious") < 1 Then

                        Set objFSO = CreateObject("Scripting.FileSystemObject")
                        Set f = objFSO.GetFile(fullFilePath)

                        'If true, then it isn't one of those funny duplicate files that microsoft makes, that has the ~ at the beginning of the file name
                        If f.Size > 5000 Then GoTo ReturnSettings

                            ' if we're here then we have found the one single file that we want! Go ahead and do our thing

                            findFile = fullFilePath
                            Exit Function

                        End If                      
                    End If                 
                End If                        
            End If     
        End If

        fileName = Dir()

    Wend

    For i = 0 To numFolders - 1

        findFile folders(i), v

    Next i

End Function

I'm a total VBA noob, so have just pva glued this together from what I can find online. Is it not working because of the findFile loop returning an array of one instead of a string? I thought the 'Exit Function' call would do away with that issue.

Please excuse the recursive if statements - the people that I am doing this for don't have a totally standard way of storing their ppts, but this hones down on the ppt I want. When the sub is complete, it will itself loop through 130 sub dirs of the selected dir, and within each of those sub dirs it will grab various slides from six different ppts and merge them into one, ie consolidate data from 780 ppts into 130 - something I definitely want to automate!

This is my first question posted on stack Overflow, so I hope I have posed it clearly and correctly. I have searched extensively for a solution to this. I hope the solution pops out to you! Many thanks in advance.

Answer 1

OK, I have a solution to this. It's not totally elegant, because it relies on globally set variables, but it works and is good enough for me:

' show if a mistake is made
Option Explicit
' globally set the var we want to return to the sub from the function
Public foundFilePath As String

Sub FindIt()

    Dim colFiles As New Collection, vFile As Variant, mypath As String
    FldrPicker As FileDialog, fileToFind As String, pptApp As Object

    Set pptApp = CreateObject("PowerPoint.Application")
    pptApp.Visible = True
    Set FldrPicker = Application.FileDialog(msoFileDialogFolderPicker)
    With FldrPicker
      .Title = "Select A Target Folder"
      .AllowMultiSelect = False
        If .Show <> -1 Then GoTo NextCode
        mypath = .SelectedItems(1) & "\"
    End With
NextCode:
    mypath = mypath
    If mypath = "" Then GoTo EndOf

    '
    ' find file
    '
    fileToFind = "*your_string_here*"
    'calls to function RecursiveDir, which sets first matching file as foundFilePath
    Call RecursiveDir(colFiles, mypath, fileToFind, True)

    ' do what you want with foundFilePath
    MsgBox "Path of file found: " & foundFilePath

    '
    'find second file
    '
    fileToFind = "*your_second_string_here*"
    Call RecursiveDir(colFiles, mypath, fileToFind, True)
    MsgBox "Second file path:  " & foundFilePath



EndOf:

End Sub


Public Function RecursiveDir(colFiles As Collection, _
                             strFolder As String, _
                             strFileSpec As String, _
                             bIncludeSubfolders As Boolean)

    Dim strTemp As String, fullFilePath As String
    Dim colFolders As New Collection
    Dim vFolderName As Variant

    'Add files in strFolder matching strFileSpec to colFiles
    strFolder = TrailingSlash(strFolder)
    strTemp = Dir(strFolder & strFileSpec)
    Do While strTemp <> vbNullString
        strFileSpec = Replace(strFileSpec, "*", "")
        If InStr(strTemp, strFileSpec) > 0 Then
            foundFilePath = strFolder & strTemp
            Exit Function
        End If
        colFiles.Add strFolder & strTemp
        strTemp = Dir
    Loop

    If bIncludeSubfolders Then
        'Fill colFolders with list of subdirectories of strFolder
        strTemp = Dir(strFolder, vbDirectory)
        Do While strTemp <> vbNullString
            If (strTemp <> ".") And (strTemp <> "..") Then
                If (GetAttr(strFolder & strTemp) And vbDirectory) <> 0 Then
                    colFolders.Add strTemp
                End If
            End If
            strTemp = Dir
        Loop

        'Call RecursiveDir for each subfolder in colFolders
        For Each vFolderName In colFolders
            Call RecursiveDir(colFiles, strFolder & vFolderName, strFileSpec, True)
        Next vFolderName
    End If

End Function


Public Function TrailingSlash(strFolder As String) As String
    If Len(strFolder) > 0 Then
        If Right(strFolder, 1) = "\" Then
            TrailingSlash = strFolder
        Else
            TrailingSlash = strFolder & "\"
        End If
    End If
End Function

That works. What was a better solution for me is the below. It uses separate subs / functions to do the following: pick a folder ; loop through first-child folders ; recursively search for a file, using a partial file name, in all folders and subfolders ; do something with the found file/s (plural if the search function is called on multiple strings).

It's not necessary to separate out like this, but I find it easier for separation of concerns and keeping things simple.

Sub 1: Root folder picker. Passes selected folder onto sub 2

Option Explicit
Public foundFilePath As String

Sub StartSub()
' selects the parent folder and passes it to LoopSuppliers

    Dim masterPath As String, FldrPicker As FileDialog, pptApp As Object

    Set pptApp = CreateObject("PowerPoint.Application")
    Set FldrPicker = Application.FileDialog(msoFileDialogFolderPicker)
    pptApp.Visible = True

    With FldrPicker
      .Title = "Select A Target Folder"
      .AllowMultiSelect = False
        If .Show <> -1 Then GoTo NextCode
        masterPath = .SelectedItems(1) & "\"
    End With
NextCode:
    masterPath = masterPath
    If masterPath = "" Then GoTo EndOf

    Call LoopSuppliers(masterPath) ' goes to masterFolder in LoopSuppliers sub

EndOf:

End Sub

Sub two: simply loops through the parent folder and passes the path of each first-child sub folder to function three to do something with it. Adapted from here.

Private Sub LoopSuppliers(masterFolder As String) 

    Dim objFSO As Object, objFolder As Object, objSupplierFolder As Object

    Set objFSO = CreateObject("Scripting.FileSystemObject")
    Set objFolder = objFSO.GetFolder(masterFolder)

    For Each objSupplierFolder In objFolder.SubFolders
        'objSupplierFolder.path   objSubFolder.Name <- object keys I can grab

        Call ManipulateFiles(objSupplierFolder.path)

    Next objSupplierFolder

End Sub

Function 1: Grabs file paths for doing something with

Private Function ManipulateFiles(ByRef FolderPath As String)

    Dim file1 As String, file2 As String, file3 As String

    ' each of these calls find a file anywhere in a suppliers subfolders, using the second param as a search string, and then holds it as a new var

    Call FindSupplierFile(FolderPath, "search_string1")
    file1 = foundFilePath

    Call FindSupplierFile(FolderPath, "search_string2")
    file2 = foundFilePath

    Call FindSupplierFile(FolderPath, "search_string3")
    file3 = foundFilePath

    '
    ' do something with the files!
    '

End Function

Function 2: This is the function that takes a dir, a search string, and then loops through all the dirs folders and sub folders until it gets a match. I've included extra filtering, to show how I further narrowed down the files that could be returned to function 1.

Private Function FindSupplierFile(ByRef FolderPath As String, ByVal v As String) As String

    Dim FileName As String, fullFilePath As String, numFolders As Long, Folders() As String, i As Long
    Dim objFSO As Object, f As Object

    If Right(FolderPath, 1) <> "\" Then FolderPath = FolderPath & "\"
    FileName = Dir(FolderPath & "*.*", vbDirectory)

    While Len(FileName) <> 0
        If Left(FileName, 1) <> "." Then

            fullFilePath = FolderPath & FileName

            If (GetAttr(fullFilePath) And vbDirectory) = vbDirectory Then

                ReDim Preserve Folders(0 To numFolders) As String
                Folders(numFolders) = fullFilePath
                numFolders = numFolders + 1

            Else
                                                                                    '
                                                                                    ' my filters
                                                                                    '
                If InStr(1, fullFilePath, "evious") < 1 Then                        ' filter out files in folders called "_p/Previous"
                    If InStr(10, fullFilePath, v) > 0 Then                          ' match for our search string 'v'

                        Set objFSO = CreateObject("Scripting.FileSystemObject")     ''
                        Set f = objFSO.GetFile(fullFilePath)                        '' use these three code lines to check that the file is more that 5kb - ie not a tiny ~ file
                                                                                    ''
                        If f.Size > 5000 Then                                       ''

                            foundFilePath = fullFilePath                            ' if we get in here we have the file that we want
                            Exit Function                                           ' as we have found the file we want we can exit the function (which means we carry on with ManipulateFiles)

                        End If  ' end f.size
                    End If      ' end InStr v if
                End If          ' end InStr evious if
                                                                                    '
                                                                                    ' end of my filters
                                                                                    '
            End If              ' end get attr if else
        End If                  ' end left if

        FileName = Dir()
    Wend                        ' while len <> 0

    For i = 0 To numFolders - 1
        FindSupplierFile Folders(i), v
    Next i

End Function

Answer 2

This is a classic case of needing to use Option Explicit.

You have a missing f from filename and this goes unchecked as a variable ilename not filename.

You should put Option Explicit at the top of every module and declare all your variables. There is also a missing label for a GoTo statement which I have added.

Note: You are doing a full string case sensitive match on the file name within the selected folder.

Option Explicit

Sub ManagementSummaryMerge()
    Dim folderPath As String, FldrPicker As FileDialog, pptApp As Object

    Set pptApp = CreateObject("PowerPoint.Application")
    pptApp.Visible = True
    Set FldrPicker = Application.FileDialog(msoFileDialogFolderPicker)

    With FldrPicker
        .Title = "Select A Target Folder"
        .AllowMultiSelect = False

        If .Show <> -1 Then GoTo NextCode
        folderPath = .SelectedItems(1) & "\"
    End With

    'In Case of Cancel
NextCode:
    folderPath = folderPath
    If folderPath = "" Then GoTo EndOfSub

    'set _Main <= string I want to look for
    Dim v As String
    v = "_Main"

    Dim fullFilePathIWantToSet As String

    'set value of fullFilePathIWantToSet from findFile function
    fullFilePathIWantToSet = findFile(folderPath, v)

    'when I test, this MsgBox appears, but blank
    MsgBox fullFilePathIWantToSet

    'If I can get this working properly, I want to be able to do something like this:

    'objFSO.CopyFile fullFilePathIWantToSet, duplicateFilePath
    'Presentations.Open (duplicateFilePath)
    'numSlides = ActivePresentation.Slides.Count
    'etc


EndOfSub:
    'let the sub end

End Sub

Function findFile(ByRef folderPath As String, ByVal v As String) As String

    Dim fileName As String
    Dim fullFilePath As String
    Dim duplicateFilePath As String
    Dim numFolders As Long
    Dim numSlides As Integer

    Dim folders() As String, i As Long

    If Right(folderPath, 1) <> "\" Then folderPath = folderPath & "\"
    fileName = Dir(folderPath & "*.*", vbDirectory)

    While Len(fileName) <> 0

        If Left(fileName, 1) <> "." Then

            fullFilePath = folderPath & fileName
            duplicateFilePath = folderPath & "duplicate " & fileName

            If (GetAttr(fullFilePath) And vbDirectory) = vbDirectory Then
                ReDim Preserve folders(0 To numFolders) As String
                folders(numFolders) = fullFilePath
                numFolders = numFolders + 1
            Else

                'if true, the it matches the string we are looking for
                If InStr(10, fullFilePath, v) > 0 Then

                    'if true, then it isn't in a dir called P/previous, which I want to avoid
                    If InStr(1, fullFilePath, "evious") < 1 Then
                        Dim objFSO As Object, f As Object
                        Set objFSO = CreateObject("Scripting.FileSystemObject")
                        Set f = objFSO.GetFile(fullFilePath)

                        'If true, then it isn't one of those funny duplicate files that microsoft makes, that has the ~ at the beginning of the file name
                        If f.Size > 5000 Then GoTo ReturnSettings

                        ' if we're here then we have found the one single file that we want! Go ahead and do our thing

                        findFile = fullFilePath
                        Exit Function

                    End If
                End If
            End If
        End If

        fileName = Dir()

    Wend

    For i = 0 To numFolders - 1

        findFile folders(i), v

    Next i

    Exit Function
ReturnSettings:
End Function