Não é possível dinamizar as folhas de importação da função de diretório?

Question

Posso modificar o código abaixo em uma importação dinâmica de folhas, para que eu possa executá-lo em qualquer folha do meu macrobook pessoal em vez de uma folha chamada import-sheets.xls ?

Encontrou o código para importar abaixo.

Dim directory As String, fileName As String, sheet As Worksheet, total As Integer

Application.ScreenUpdating = False
Application.DisplayAlerts = False

directory = "c: est\"
fileName = Dir(directory & "*.xl??")

Do While fileName <> ""

Loop

Workbooks.Open (directory & fileName)

For Each sheet In Workbooks(fileName).Worksheets
    total = Workbooks("import-sheets.xls").Worksheets.count
    Workbooks(fileName).Worksheets(sheet.Name).Copy _
    after:=Workbooks("import-sheets.xls").Worksheets(total)
Next sheet

Workbooks(fileName).Close

fileName = Dir()

9. Turn on screen updating and displaying alerts again (outside the loop).
Application.ScreenUpdating = True
Application.DisplayAlerts = True

Eu também gostaria de alterar o diretório em uma função para que eu possa procurar manualmente o diretório através do Explorer, sem modificar o script de cada vez.

Encontrei o seguinte código online:

Public Function GetFolderName(Optional OpenAt As String) As String
Dim lCount As Long

GetFolderName = vbNullString

With Application.FileDialog(msoFileDialogFolderPicker)
    .InitialFileName = OpenAt
    .Show
    For lCount = 1 To .SelectedItems.Count
        GetFolderName = .SelectedItems(lCount)
    Next lCount
End With

End sub

Acho que seria uma correção fácil alterar directory = "c: est\ para directory = GetFolderName() , mas ainda não é possível testá-lo, porque o código acima não funciona.

    

Answer 1

Eu usei o seguinte código para resolver meus problemas:

Eu criei AvivoWB = ActiveWorkbook e usei isso no código.

Como minha expectativa, precisei alterar o directory = "c: est\" para directory = GetFolderName() & "/"

Sub Import_Excel_sheets()

Dim directory As String
Dim fileName As String
Dim sheet As Worksheet
Set ActivoWB = ActiveWorkbook

Application.ScreenUpdating = False
Application.DisplayAlerts = False

directory = GetFolderName() & "/"
fileName = Dir(directory & "*.xl??")

Do While fileName <> ""
    Workbooks.Open (directory & fileName)

    For Each sheet In Workbooks(fileName).Worksheets
        Workbooks(fileName).Worksheets(sheet.Name).Copy _
        after:=ActivoWB.Sheets(ActivoWB.Sheets.Count)
    Next sheet

    Workbooks(fileName).Close
    fileName = Dir()
Loop

Application.ScreenUpdating = True
Application.DisplayAlerts = True

End Sub

O código da função não foi alterado e também deve ser adicionado à pasta de trabalho:

Public Function GetFolderName(Optional OpenAt As String) As String
Dim lCount As Long

GetFolderName = vbNullString

With Application.FileDialog(msoFileDialogFolderPicker)
    .InitialFileName = OpenAt
    .Show
    For lCount = 1 To .SelectedItems.Count
        GetFolderName = .SelectedItems(lCount)
    Next lCount
End With
End Function