Notifications
Clear all

Selecionar pasta e Abrir Planilha

4 Posts
2 Usuários
0 Reactions
1,343 Visualizações
(@edilsonjc)
Posts: 39
Eminent Member
Topic starter
 

Gostaria de melhorar este código abaixo com os seguintes passos:
1. Selecionar um diretório específico (e.g. "E:" ou pasta na rede);
2. Abrir em outras extensões do excel (*.xls, *.xlsx, *.xlsm)
O código abaixo não permite tal coisa, já procurei aqui e na net e não encontrei para adaptar.
Quando consigo abrir arquivo, não consigo abrir diretório específico e vice-versa.

Sub OpenFile()
   
Set xl = CreateObject("Excel.Sheet")

ArqParaAbrir = Application.GetOpenFilename("Arquivos do Excel (*.xlsm), *.xlsm")

If ArqParaAbrir <> False Then

'MsgBox "A seguinte planilha será carregada: " & ArqParaAbrir

xl.Application.Workbooks.Open ArqParaAbrir

End If
 
Postado : 25/06/2014 1:17 pm
Fernando Fernandes
(@fernandofernandes)
Posts: 43750
Illustrious Member
 

Boa tarde!!

Não testado.

Sub AleVBA_12249()
Dim FSO As Scripting.FileSystemObject, folder As Scripting.folder, file As Scripting.file, wb As Workbook
Dim directory As String
 
    directory = "C:SeuLocal"
    
    Set FSO = CreateObject("Scripting.FileSystemObject")
    Set folder = FSO.GetFolder(directory)
    
    For Each file In folder.Files
        Workbooks.Open file
    Next file
End Sub

Att

Existem mil maneiras de preparar Neston. Invente a sua!
http://www.youtube.com/ExpressoExcel

 
Postado : 25/06/2014 2:02 pm
(@edilsonjc)
Posts: 39
Eminent Member
Topic starter
 

Não funcionou. Etá dando erro de compilação.

 
Postado : 25/06/2014 2:34 pm
(@edilsonjc)
Posts: 39
Eminent Member
Topic starter
 

Bom gente, encontrei a solução.
Funcionou perfeito.
Se alguém interessar segue abaixo.
:D

Sub OpenFile()
Dim fd As FileDialog
Dim SelectedItem As Variant


    Set fd = Application.FileDialog(msoFileDialogFilePicker)

    With fd

        .AllowMultiSelect = False
        .InitialFileName = "E:"
        .Filters.Clear
        .Filters.Add "Arquivos do Excel", "*.xlsm, *.xlsx"
        .FilterIndex = 1
        
        If .Show = -1 Then

            For Each SelectedItem In .SelectedItems

                Workbooks.Open (SelectedItem)
                'do something with activeworkbook
            Next SelectedItem
        End If
    End With

    Set fd = Nothing


End Sub
 
Postado : 25/06/2014 4:43 pm