VBA - sélectionner un dossier et le référencer comme chemin d'accès à un code distinct

Question

Je peux utiliser ce code pour sélectionner un dossier :

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

J'ai aussi ce code, qui fonctionne lorsque le chemin du dossier est codé en dur.Fondamentalement, cela me donne une liste de noms de fichiers et de chemins de fichiers que j'utiliserai plus tard dans une section distincte.Actuellement, le chemin du dossier codé en dur est commenté et j'essaie d'utiliser le code ci-dessus pour sélectionner le dossier à chaque fois afin qu'il soit plus convivial.

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

Cependant, je ne sais pas comment faire fonctionner ensemble les deux jeux de codes différents.Je suppose que la seule partie que je dois changer est la suivante :

Set objFolder = objFSO.GetFolder(ChooseFolder)

Je l'ai sous le nom ChooseFolder qui est le sous ci-dessus pour l'instant mais ce n'est clairement pas la bonne façon de procéder.Je l'ai également essayé avec sItem mais cela ne semble pas fonctionner.

Answer 1

Juste pour développer mon commentaire avec une meilleure explication, vous avez défini ChooseFolder en tant que sous.Les sous-marins ne renvoient pas de valeurs.Cependant, vous l'utilisez comme fonction lorsque vous effectuez ceci :

Set objFolder = objFSO.GetFolder(ChooseFolder)

parce que tu transmets le résultat de ta course ChooseFolder à l'OFS GetFolder fonction.

Ce que vous devez faire, c'est déclarer ChooseFolder en tant que fonction.

En gros, remplacez votre ChooseFolder Sub avec ceci :

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

et il devrait alors faire ce que vous attendez.Le reste de votre code est bon.

Answer 2

faire Choosefolder () dans une fonction , puis la référence:

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