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

VBA - selecting a folder and referencing it as the path for a separate code

提问by sxh345

I'm able to use this code to select a folder:

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

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

I also have this code, that works when the folder path is hardcoded. Basically, it gives me a list of file names and file paths that I use later in a separate section. Currently I have the hardcoded folder path commented out and I'm trying to use the above code to select the folder each time so that it is more user friendly.

我也有这个代码，当文件夹路径被硬编码时它起作用。基本上，它为我提供了一个文件名和文件路径列表，我稍后会在单独的部分中使用这些文件名和文件路径。目前，我已将硬编码的文件夹路径注释掉，并且我每次都尝试使用上面的代码来选择文件夹，以使其更加用户友好。

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

However, I'm not sure how to get the two different code sets to work together. I'm guessing the only part I need to change is this:

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

Set objFolder = objFSO.GetFolder(ChooseFolder)

I have it as ChooseFolder which is the sub above for now but that is clearly not the way to go about it. I tried it with sItem as well but that doesn't seem to work.

我把它作为 ChooseFolder ，它现在是上面的子，但这显然不是解决它的方法。我也用 sItem 尝试过，但这似乎不起作用。

回答by djikay

Just to build on my comment with a better explanation, you have defined ChooseFolderas a Sub. Subs do not return values. However, you're using it as a Function when you do this:

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

Set objFolder = objFSO.GetFolder(ChooseFolder)

because you're passing the result of running ChooseFolderto the FSO's GetFolderfunction.

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

What you need to do is declare ChooseFolderas a Function.

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

Basically, replace your ChooseFolderSub with this:

基本上，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

and it should then do what you expect. The rest of your code is fine.

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

回答by Gary's Student

Make ChooseFolder()into a functionand then reference it:

将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