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.
La solution
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.
Autres conseils
faire Choosefolder () dans une fonction
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