VBA — выбор папки и ссылка на нее как путь к отдельному коду

StackOverflow https://stackoverflow.com//questions/25087412

  •  02-01-2020
  •  | 
  •  

Вопрос

Я могу использовать этот код для выбора папки:

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)

У меня это ChooseFolder, который на данный момент является подпунктом выше, но это явно не лучший способ сделать это.Я тоже пробовал это с sItem, но, похоже, это не работает.

Это было полезно?

Решение

Просто чтобы развить мой комментарий и дать лучшее объяснение, вы определили ChooseFolder в качестве суб.Подсистемы не возвращают значения.Однако вы используете его как функцию, когда делаете это:

Set objFolder = objFSO.GetFolder(ChooseFolder)

потому что вы передаете результат работы ChooseFolder в ФСО GetFolder функция.

Что вам нужно сделать, это объявить ChooseFolder как функция.

В общем, замените ChooseFolder Саб с этим:

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

и тогда он должен делать то, что вы ожидаете.Остальная часть вашего кода в порядке.

Другие советы

Сделайте Выберите Функция () в функцию а затем ссылаться на него:

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
.

Лицензировано под: CC-BY-SA с атрибуция
Не связан с StackOverflow
scroll top