Abrir planilhas em um diretorio

douglas.almeida · Ter Fev 25, 2020 2:04 pm

Galera, bom dia

Tenho uma planilha com uma macro feita onde ela precisa fazer uma consulta com filtro avançado em 2 planilhas que estao em um diretório, ("S:\TI\9-Gestao_de_Acesso\ADP - Download do dia\Teste ADP\planilha_de_exe.csv")
e apos isso inserir as informações que preciso em outras 2 planilhas

Na verdade minha dificuldade é apenas fazer uma macro para abrir as planilhas que precisar, apos pegar as informações precisaria de outra macro para fechelas

alguem pode me ajudar?

Desde ja grato

srobles · Mensagem por **srobles** » Qua Fev 26, 2020 7:38 pm

Douglas,

Experimente o que se segue abaixo.

Adicione um novo módulo á pasta de trabalho, copie e cole a rotina :

Código: Selecionar todos

Public pastasSelecionadas() As String

Sub selecionarArquivos()
    Dim caixaArquivo As Office.FileDialog
    
    Erase pastasSelecionadas
    
    Set caixaArquivo = Application.FileDialog(msoFileDialogFilePicker)
        
        With caixaArquivo
            .AllowMultiSelect = True
            .Filters.Clear
            .Filters.Add "Arquivos do Excel", "*.xls*, *.csv"
            .InitialFileName = ThisWorkbook.Path
            .InitialView = msoFileDialogViewList
            .Title = "Seleciona o(s) arquivo(s)"
            .Show
        End With
        
        Application.ScreenUpdating = False
        
        If caixaArquivo.SelectedItems.Count >= 1 Then
            ReDim pastasSelecionadas(1 To caixaArquivo.SelectedItems.Count)
            
            For vPasta = 1 To caixaArquivo.SelectedItems.Count
                Workbooks.Open caixaArquivo.SelectedItems(vPasta)
                pastasSelecionadas(vPasta) = ActiveWorkbook.Name
            Next
            
            '=========================================================================
            'Insira aqui as rotinas que serão executadas após a abertura dos arquivos
            '=========================================================================
                    
            Dim nomeArquivo As String
            
            For vPasta1 = 1 To UBound(pastasSelecionadas)
                nomeArquivo = ""
                nomeArquivo = pastasSelecionadas(vPasta1)
                Windows(nomeArquivo).Activate
                ActiveWorkbook.Close False
            Next
            
            Application.ScreenUpdating = True
            nomeArquivo = ""
            Set caixaArquivo = Nothing
            
            MsgBox "Atualização realizada com sucesso!", vbInformation, "Atualização"
            
        Else
            Application.ScreenUpdating = True
            nomeArquivo = ""
            Set caixaArquivo = Nothing
            MsgBox "Operação cancelada pelo usuário!", vbExclamation, "Atualização"
            Exit Sub
        End If
End Sub

Após isso, chame a rotina (selecionarArquivos) através de teclas de atalho ou de um botão em uma guia qualquer.

douglas.almeida · Qui Fev 27, 2020 11:09 am

Valeu man,

mais uma ajuda, nao manjo de VBA

a macro que fiz que preciso que rode, tem esse código;
Sub aTesteConsultarCRs()
'
' aTesteConsultarCRs Macro
'

'
Application.CutCopyMode = False
Application.CutCopyMode = False
Application.CutCopyMode = False

ActiveWindow.ScrollColumn = 2
ActiveWindow.ScrollColumn = 3
ActiveWindow.ScrollColumn = 4
ActiveWindow.ScrollColumn = 5
ActiveWindow.ScrollColumn = 6
ActiveWindow.ScrollColumn = 7
Range("I7:L8").Select
Selection.Copy
Range("AD7").Select
ActiveSheet.Paste
Range("AD9").Select
Application.CutCopyMode = False
Application.CutCopyMode = False
ActiveCell.FormulaR1C1 = "=RC[-23]"
Range("A9").Select
Application.CutCopyMode = False
Application.CutCopyMode = False
Application.CutCopyMode = False
Application.CutCopyMode = False

Windows("export-grupo-dados.csv").Activate
Windows("Consultar ADP.xlsm").Activate
Range("A6").Select
End Sub

Tentei adicionar onde indicou no codigo e deu erro, consegue me dizer como exatamente coloco esse codigo?

srobles · Mensagem por **srobles** » Qui Fev 27, 2020 2:49 pm

Douglas,

Os arquivos que deseja abrir sempre estarão localizados no mesmo local?
Caso positivo, altere esta linha da rotina :

Código: Selecionar todos

.InitialFileName = ThisWorkbook.Path

Para :

Código: Selecionar todos

.InitialFileName = caminhoAbsoluto

Onde caminhoAbsoluto será o caminho completo de onde os arquivos estão, exemplo "S:\TI\9-Gestao_de_Acesso\ADP - Download do dia\Teste ADP\"

Repare também, que a janela para selecionar os arquivos, permite a seleção de múltiplos arquivos, pois possui a instrução AllowMultiSelect = True.

Após abrir os arquivos desejados, em seu bloco de códigos, você deverá definir qual a pasta á ser selecionada para que o mesmo seja executado, veja exemplo :

Antes do seu bloco de códigos, adicione a instrução :

Código: Selecionar todos

Windows(nomeDaPastaDeTrabalho).Activate

Onde nomeDaPastaDeTrabalho será o nome do arquivo que deseja realizar a operações contidas no seu bloco de códigos.

Após a linha acima, adicione seu bloco de códigos sem o Sub e o End Sub, respectivamente, ficando :

Código: Selecionar todos

'Ativamos a pasta de trabalho
Windows(nomeDaPastaDeTrabalho).Activate

'Realizamos as operações contidas na sua macro.
Application.CutCopyMode = False
Application.CutCopyMode = False
Application.CutCopyMode = False

ActiveWindow.ScrollColumn = 2
ActiveWindow.ScrollColumn = 3
ActiveWindow.ScrollColumn = 4
ActiveWindow.ScrollColumn = 5
ActiveWindow.ScrollColumn = 6
ActiveWindow.ScrollColumn = 7
Range("I7:L8").Select
Selection.Copy
Range("AD7").Select
ActiveSheet.Paste
Range("AD9").Select
Application.CutCopyMode = False
Application.CutCopyMode = False
ActiveCell.FormulaR1C1 = "=RC[-23]"
Range("A9").Select
Application.CutCopyMode = False
Application.CutCopyMode = False
Application.CutCopyMode = False
Application.CutCopyMode = False

Windows("export-grupo-dados.csv").Activate
Windows("Consultar ADP.xlsm").Activate
Range("A6").Select

Em um exemplo bem simplificado, a macro final ficaria parecida com o que se segue :

Código: Selecionar todos

Public pastasSelecionadas() As String

Sub selecionarArquivos()
    Dim caixaArquivo As Office.FileDialog
    
    Erase pastasSelecionadas
    
    Set caixaArquivo = Application.FileDialog(msoFileDialogFilePicker)
        
        With caixaArquivo
            .AllowMultiSelect = True
            .Filters.Clear
            .Filters.Add "Arquivos do Excel", "*.xls*, *.csv"
            .InitialFileName = "S:\TI\9-Gestao_de_Acesso\ADP - Download do dia\Teste ADP\"
            .InitialView = msoFileDialogViewList
            .Title = "Selecione o(s) arquivo(s)"
            .Show
        End With
        
        Application.ScreenUpdating = False
        
        'Aqui abrimos os arquivos selecionados no diretório
        If caixaArquivo.SelectedItems.Count >= 1 Then
            ReDim pastasSelecionadas(1 To caixaArquivo.SelectedItems.Count)
            
            For vPasta = 1 To caixaArquivo.SelectedItems.Count
                Workbooks.Open caixaArquivo.SelectedItems(vPasta)
                pastasSelecionadas(vPasta) = ActiveWorkbook.Name
            Next
            
            'SUA ROTINA MODIFICADA
            '=========================================================================
            'Insira aqui as rotinas que serão executadas após a abertura dos arquivos
            
                'Ativamos a pasta de trabalho
                Windows(nomeDaPastaDeTrabalho).Activate
                
                'Realizamos as operações contidas na sua macro.
                Application.CutCopyMode = False
                Application.CutCopyMode = False
                Application.CutCopyMode = False
                
                ActiveWindow.ScrollColumn = 2
                ActiveWindow.ScrollColumn = 3
                ActiveWindow.ScrollColumn = 4
                ActiveWindow.ScrollColumn = 5
                ActiveWindow.ScrollColumn = 6
                ActiveWindow.ScrollColumn = 7
                Range("I7:L8").Select
                Selection.Copy
                Range("AD7").Select
                ActiveSheet.Paste
                Range("AD9").Select
                Application.CutCopyMode = False
                Application.CutCopyMode = False
                ActiveCell.FormulaR1C1 = "=RC[-23]"
                Range("A9").Select
                Application.CutCopyMode = False
                Application.CutCopyMode = False
                Application.CutCopyMode = False
                Application.CutCopyMode = False
                
                Windows("export-grupo-dados.csv").Activate
                Windows("Consultar ADP.xlsm").Activate
                Range("A6").Select
            '=========================================================================
                    
            Dim nomeArquivo As String
            
            'Aqui fechamos todos os arquivos abertos no passo anterior
            For vPasta1 = 1 To UBound(pastasSelecionadas)
                nomeArquivo = ""
                nomeArquivo = pastasSelecionadas(vPasta1)
                Windows(nomeArquivo).Activate
                ActiveWorkbook.Close False
            Next
            
            Application.ScreenUpdating = True
            nomeArquivo = ""
            Set caixaArquivo = Nothing
            
            MsgBox "Atualização realizada com sucesso!", vbInformation, "Atualização"
            
        Else
            Application.ScreenUpdating = True
            nomeArquivo = ""
            Set caixaArquivo = Nothing
            MsgBox "Operação cancelada pelo usuário!", vbExclamation, "Atualização"
            Exit Sub
        End If
End Sub

Abrir planilhas em um diretorio

Abrir planilhas em um diretorio

Re: Abrir planilhas em um diretorio

Re: Abrir planilhas em um diretorio

Re: Abrir planilhas em um diretorio