VBA - se seleccionar uma pasta, e faz referência a ele como o caminho para um código separado

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

  •  02-01-2020
  •  | 
  •  

Pergunta

Eu sou capaz de usar este código para seleccionar uma pasta:

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

Eu também tenho esse código, que funciona quando o caminho da pasta é codificado.Basicamente, ele me dá uma lista de nomes de arquivo e caminhos de arquivos que eu uso, mais tarde, em uma seção separada.Atualmente tenho codificado caminho da pasta comentada e eu estou tentando usar o código acima para selecionar a pasta de cada vez, de modo que é mais fácil de usar.

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

No entanto, eu não tenho certeza de como chegar a dois conjuntos de códigos diferentes para trabalhar juntos.Eu estou supondo que a única parte que eu preciso mudar é este:

Set objFolder = objFSO.GetFolder(ChooseFolder)

Eu tenho ele como ChooseFolder que é o sub acima para agora, mas que claramente não é a maneira de ir sobre ele.Eu tentei com sItem tão bem, mas que não parecem funcionar.

Foi útil?

Solução

Apenas para construir o meu comentário com uma explicação melhor, que você tenha definido ChooseFolder como uma Sub-rotina.Subs não retornam valores.No entanto, você está usando-o como uma Função quando você fazer isso:

Set objFolder = objFSO.GetFolder(ChooseFolder)

porque você está passando o resultado da execução ChooseFolder para o FOE GetFolder função.

O que você precisa fazer é declarar ChooseFolder como uma Função.

Basicamente, substituir o ChooseFolder Sub com este:

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

e, em seguida, deve fazer o que você espera.O resto do código é bom.

Outras dicas

Fazer ChooseFolder() em um função e, em seguida, fazer referência a ele:

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
Licenciado em: CC-BY-SA com atribuição
Não afiliado a StackOverflow
scroll top