Powerpoint VBA函数返回不工作

这让我抓狂：我在powerpoint vba中有一个sub和一个函数

sub首先允许我选择一个目录。从sub调用的函数在目录中查找文件。我希望它作为子函数之外的函数，因为我需要多次使用它

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

子管理摘要合并（）
将folderPath设置为字符串
'选择目录
Dim FldrPicker As FILE对话框
设置pptap=CreateObject（“PowerPoint.Application”）
pptApp.Visible=True
'从用户检索目标文件夹路径
Set FldrPicker=Application.FileDialog（msoFileDialogFolderPicker）
用FldrPicker
.Title=“选择目标文件夹”
.AllowMultiSelect=False
如果.Show-1，则转到下一个代码
folderPath=.SelectedItems（1）和“\”
以
"如果取消,
下一个代码：
folderPath=folderPath
如果folderPath=“则转到EndOfSub
'set _Main这是需要使用
选项Explicit
的典型案例

您的
filename
中缺少
f
，这将作为变量
ilename
而不是
filename
取消选中

您应该将
选项Explicit
放在每个模块的顶部，并声明所有变量。我添加的
GoTo
语句也缺少一个标签

注意：您正在对所选文件夹中的文件名进行全字符串区分大小写的匹配

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

选项显式
子管理摘要合并（）
Dim folderPath作为字符串，FldrPicker作为文件对话框，pptApp作为对象
设置pptap=CreateObject（“PowerPoint.Application”）
pptApp.Visible=True
Set FldrPicker=Application.FileDialog（msoFileDialogFolderPicker）
用FldrPicker
.Title=“选择目标文件夹”
.AllowMultiSelect=False
如果.Show-1，则转到下一个代码
folderPath=.SelectedItems（1）和“\”
以
"如果取消,
下一个代码：
folderPath=folderPath
如果folderPath=“则转到EndOfSub
'set _Main这是需要使用
选项Explicit
的典型案例

您的
filename
中缺少
f
，这将作为变量
ilename
而不是
filename
取消选中

您应该将
选项Explicit
放在每个模块的顶部，并声明所有变量。我添加的
GoTo
语句也缺少一个标签

注意：您正在对所选文件夹中的文件名进行全字符串区分大小写的匹配

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

选项显式
子管理摘要合并（）
Dim folderPath作为字符串，FldrPicker作为文件对话框，pptApp作为对象
设置pptap=CreateObject（“PowerPoint.Application”）
pptApp.Visible=True
Set FldrPicker=Application.FileDialog（msoFileDialogFolderPicker）
用FldrPicker
.Title=“选择目标文件夹”
.AllowMultiSelect=False
如果.Show-1，则转到下一个代码
folderPath=.SelectedItems（1）和“\”
以
"如果取消,
下一个代码：
folderPath=folderPath
如果folderPath=“则转到EndOfSub
'set _Main好的，我有一个解决方案。它并不完全优雅，因为它依赖于全局设置的变量，但它工作正常，对我来说已经足够好了：

' 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

函数2:这是一个函数，它接受一个目录、一个搜索字符串，然后在所有目录文件夹和子文件夹中循环，直到找到匹配项。我已经包括了额外的过滤，以显示我如何进一步缩小可以返回到函数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

私有函数FindSupplierFile（ByRef FolderPath作为字符串，ByVal v作为字符串）作为字符串
Dim FileName为字符串，fullFilePath为字符串，numFolders为长，Folders（）为字符串，i为长
Dim objFSO作为对象，f作为对象
如果正确（FolderPath，1）“\”则FolderPath=FolderPath&“\”
FileName=Dir（FolderPath&“***”，vbDirectory）
而Len（文件名）0
如果左（文件名，1）”，则
fullFilePath=FolderPath&FileName
如果（GetAttr（fullFilePath）和vbDirectory）=vbDirectory，则
重拨将文件夹（0到numFolders）保留为字符串
文件夹（numFolders）=完整文件路径
numFolders=numFolders+1
其他的
'
“我的过滤器
'
如果InStr（1，fullFilePath，“evious”）<1，则“过滤掉名为“\u p/Previous”的文件夹中的文件”
如果InStr（10，fullFilePath，v）>0，则“匹配我们的搜索字符串“v”
设置objFSO=CreateObject（“Scripting.FileSystemObject”）“”
设置f=objFSO.GetFile（fullFilePath）“'使用这三行代码检查文件是否超过5kb-即不是一个小文件
''
如果f.尺寸>5000，则“
foundFilePath=fullFilePath'如果我们进入这里，我们就得到了想要的文件
“退出函数”当我们找到所需的文件时，我们可以退出该函数（这意味着我们继续处理操纵文件）
如果结束，则结束f尺寸
如果“e”结束
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

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

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