VBA - 选择一个文件夹并将其作为单独代码的路径引用

Question

我可以使用此代码选择文件夹：

Sub ChooseFolder()
Dim fldr As FileDialog
Dim sItem As String

Set fldr = Application.FileDialog(msoFileDialogFolderPicker)
With fldr
    .Title = "Select a Folder"
    .AllowMultiSelect = False
    .InitialFileName = strPath
    If .Show <> -1 Then GoTo NextCode
    sItem = .SelectedItems(1)
End With

NextCode:
GetFolder = sItem
Set fldr = Nothing
End Sub

我也有这个代码，它在文件夹路径被硬编码时工作。基本上，它给了我一个文件名和文件路径的列表，我稍后会在单独的部分中使用它们。目前我已经将硬编码的文件夹路径注释掉了，我尝试使用上面的代码每次都选择文件夹，这样对用户更加友好。

Private Sub btn_LeaveReport()
Dim objFSO As Object
Dim objFolder As Object
Dim objFile As Object
Dim i As Integer

'Create an instance of the FileSystemObject
Set objFSO = CreateObject("Scripting.FileSystemObject")

'Get the folder object
'Set objFolder = objFSO.GetFolder("D:\Administration\Time Sheets")
Set objFolder = objFSO.GetFolder(ChooseFolder)
i = 3

'loops through each file in the directory and prints their names and path
For Each objFile In objFolder.Files
    'print file name
    Cells(i + 1, 2) = objFile.Name
    'print file path
    Cells(i + 1, 3) = objFile.Path
    i = i + 1
Next objFile
End Sub

但是，我不确定如何让两个不同的代码集一起工作。我猜我需要改变的唯一部分是：

Set objFolder = objFSO.GetFolder(ChooseFolder)

我现在将它作为选择文件夹，它是上面的子，但这显然不是解决方法。我也用 sItem 尝试过，但似乎不起作用。

Answer 1

为了更好地解释我的评论，您已将 ChooseFolder 定义为 Sub。 Subs 不返回值。但是，当您执行此操作时，您将其用作函数：

Set objFolder = objFSO.GetFolder(ChooseFolder)

因为您将运行 ChooseFolder 的结果传递给 FSO 的 GetFolder 函数。

您需要做的是将ChooseFolder 声明为一个函数。

基本上，将您的ChooseFolder Sub 替换为：

Function ChooseFolder() As String
    Dim fldr As FileDialog
    Dim sItem As String

    Set fldr = Application.FileDialog(msoFileDialogFolderPicker)
    With fldr
        .Title = "Select a Folder"
        .AllowMultiSelect = False
        .InitialFileName = strPath
        If .Show <> -1 Then GoTo NextCode
        sItem = .SelectedItems(1)
    End With

NextCode:
    ChooseFolder = sItem
    Set fldr = Nothing
End Function

然后它应该做你期望的事情。您的其余代码都很好。

Answer 2

把ChooseFolder()变成一个函数，然后引用它：

Public Function ChooseFolder()
    Dim fldr As FileDialog
    Dim sItem As String

    Set fldr = Application.FileDialog(msoFileDialogFolderPicker)
    With fldr
        .Title = "Select a Folder"
        .AllowMultiSelect = False
        .InitialFileName = strPath
        If .Show <> -1 Then GoTo NextCode
        sItem = .SelectedItems(1)
    End With

NextCode:
    ChooseFolder = sItem
    Set fldr = Nothing
End Function


Private Sub btn_LeaveReport()
Dim objFSO As Object
Dim objFolder As Object
Dim objFile As Object
Dim i As Integer
Dim sFldr As String

'Create an instance of the FileSystemObject
Set objFSO = CreateObject("Scripting.FileSystemObject")

sFldr = ChooseFolder()
Set objFolder = objFSO.GetFolder(sFldr)
i = 3

'loops through each file in the directory and prints their names and path
For Each objFile In objFolder.Files
    'print file name
    Cells(i + 1, 2) = objFile.Name
    'print file path
    Cells(i + 1, 3) = objFile.Path
    i = i + 1
Next objFile
End Sub