Página 1 de 1

Macro para selecionar arquivos em uma Pasta !

Enviado: Qua Jan 23, 2019 11:05 am
por AndersonDorneles
Olá, Bom dia,

Vou explicar o que eu preciso. Tenho uma planilha onde em uma coluna tenho chaves de notas fiscais eletrônicas em uma lista. Do outro lado eu tenho uma pasta com os arquivos .XML das notas, onde o nome do arquivo é a própria chave. Exemplo : 15140107724182000192550010000085701002233345 (esta na planilha), e existe o seu correspondente em uma pasta com o seguinte nome de arquivo : 15140107724182000192550010000085701002233345.xml.

Estou precisando de uma macro que acesse a pasta onde esta os arquivos .XML, separe os arquivos que preciso baseando-se numa lista que esta numa planilha do Excel, crie uma nova pasta e cole os arquivos dentro dessa nova pasta.

Vou descrever o motivo desse pedido. 1 - Que o sistema de pesquisa de arquivos em pastas do Windows não faz a pesquisa de mais de 1 arquivo, se fosse possível eu colocaria a lista inteira na pesquisa (avançada) e ele já me retornava somente os arquivos que eu preciso. 2 - Fazer esse trabalho manualmente me levaria muito tempo, as vezes no montante dos arquivos .XML é a movimentação de notas de um ano inteiro de uma empresa, então são 10 mil, 20 mil notas pra eu ter que separar umas 100, 200, fazendo essa pesquisa 1 a 1, é muito tempo gasto.

Desde já agradeço!

Anderson S. Dorneles

Re: Macro para selecionar arquivos em uma Pasta !

Enviado: Qua Jan 23, 2019 1:37 pm
por PRMPOKER
Prezados, boa tarde.

Caro AndersonDorneles, tudo bem?

Há alguns meses, desenvolvi uma solução parecida com o que precisas: um userform no Excel que permite buscar planilhas (ou outro tipo de arquivos) dentro de detrminado diretório, e lista todos que baterem com o critério de busca. Inclusive, se for Excel, ele verifica o CONTEÚDO das células e busca a string.

Essa mesma lógica poderia ser usada para desenvolver uma solução para você.

Caso tenhas interesse, por favor, entre em contato e faço um orçamento.

Um abraço!

Re: Macro para selecionar arquivos em uma Pasta !

Enviado: Qua Jan 23, 2019 2:28 pm
por AndersonDorneles
PRMPOKER escreveu: Qua Jan 23, 2019 1:37 pm Prezados, boa tarde.

Caro AndersonDorneles, tudo bem?

Há alguns meses, desenvolvi uma solução parecida com o que precisas: um userform no Excel que permite buscar planilhas (ou outro tipo de arquivos) dentro de detrminado diretório, e lista todos que baterem com o critério de busca. Inclusive, se for Excel, ele verifica o CONTEÚDO das células e busca a string.

Essa mesma lógica poderia ser usada para desenvolver uma solução para você.

Caso tenhas interesse, por favor, entre em contato e faço um orçamento.

Um abraço!
Olá,

Orçamento ? Na verdade é que eu estou sem tempo, e ja tinha iniciado uma macro pra fazer isso, e assim que terminar vou postar aqui de forma gratuita pra todos, mesmo assim obrigado, vou me virar aqui.

P.S Será que estou no forum correto ?

Anderson S. Dorneles

Re: Macro para selecionar arquivos em uma Pasta !

Enviado: Qui Jan 24, 2019 11:41 am
por PRMPOKER
Prezados, boa tarde.

Caro AndersonDorneles, tudo bem?

Perfeito. Qualquer coisa, estamos às ordens.

Um abraço.

Re: Macro para selecionar arquivos em uma Pasta !

Enviado: Sex Jan 25, 2019 7:19 am
por Reinaldo
Segue uma rotina que "faz" o que descreve, veja se ocnsegue adaptar a sua realizade

Código: Selecionar todos

Sub Copy_Move_Files_In_Folder()
'Note: If the files in ToPath already exist it will overwrite existing files in this folder
Dim FSO As Object
Dim FromPath As String, ToPath As String, FileExt As String, sPath As String
Dim linha As Integer

'Obtem caminho onde está o arquivo -- Altere para seu local
sPath = "D:\Musicas\Internacional"
'Acrescenta a barra "\" se necessario
If Right(sPath, 1) <> "\" Then
    sPath = sPath & "\"
Else
    sPath = sPath
End If

'Inicia loop considerando total de linhas na coluna "F" -- Altere para seu local
For linha = 1 To Cells(Cells.Rows.Count, "F").End(xlUp).Row
    FileExt = Cells(linha, "F").Value2 & ".mp3"   'Altere para sua extensão de arquivo e coluna desejada
    FromPath = sPath & Left(FileExt, 1) & "\"
    ToPath = "C:\Temp\"                                  'Altere para seu diretorio desejado

    If Right(FromPath, 1) <> "\" Then
        FromPath = FromPath & "\"
    End If

    Set FSO = CreateObject("scripting.filesystemobject")

    If FSO.FolderExists(FromPath) = False Then
        MsgBox FromPath & " doesn't exist"
        Exit Sub
    End If

    If FSO.FolderExists(ToPath) = False Then
        MsgBox ToPath & " doesn't exist"
        Exit Sub
    End If
    On Error Resume Next
    'FSO.GetFile FromPath & FileExt
    'Copia do arquivo
    FSO.CopyFile Source:=FromPath & FileExt, Destination:=ToPath & FileExt
    'Move arquivo
    FSO.MoveFile Source:=FromPath & FileExt, Destination:=ToPath & FileExt
    'MsgBox "You can find the files from " & FromPath & " in " & ToPath
Next
End Sub

Re: Macro para selecionar arquivos em uma Pasta !

Enviado: Sex Jan 25, 2019 9:19 am
por AndersonDorneles
Reinaldo escreveu: Sex Jan 25, 2019 7:19 am Segue uma rotina que "faz" o que descreve, veja se ocnsegue adaptar a sua realizade

Código: Selecionar todos

Sub Copy_Move_Files_In_Folder()
'Note: If the files in ToPath already exist it will overwrite existing files in this folder
Dim FSO As Object
Dim FromPath As String, ToPath As String, FileExt As String, sPath As String
Dim linha As Integer

'Obtem caminho onde está o arquivo -- Altere para seu local
sPath = "D:\Musicas\Internacional"
'Acrescenta a barra "\" se necessario
If Right(sPath, 1) <> "\" Then
    sPath = sPath & "\"
Else
    sPath = sPath
End If

'Inicia loop considerando total de linhas na coluna "F" -- Altere para seu local
For linha = 1 To Cells(Cells.Rows.Count, "F").End(xlUp).Row
    FileExt = Cells(linha, "F").Value2 & ".mp3"   'Altere para sua extensão de arquivo e coluna desejada
    FromPath = sPath & Left(FileExt, 1) & "\"
    ToPath = "C:\Temp\"                                  'Altere para seu diretorio desejado

    If Right(FromPath, 1) <> "\" Then
        FromPath = FromPath & "\"
    End If

    Set FSO = CreateObject("scripting.filesystemobject")

    If FSO.FolderExists(FromPath) = False Then
        MsgBox FromPath & " doesn't exist"
        Exit Sub
    End If

    If FSO.FolderExists(ToPath) = False Then
        MsgBox ToPath & " doesn't exist"
        Exit Sub
    End If
    On Error Resume Next
    'FSO.GetFile FromPath & FileExt
    'Copia do arquivo
    FSO.CopyFile Source:=FromPath & FileExt, Destination:=ToPath & FileExt
    'Move arquivo
    FSO.MoveFile Source:=FromPath & FileExt, Destination:=ToPath & FileExt
    'MsgBox "You can find the files from " & FromPath & " in " & ToPath
Next
End Sub
Olá Bom dia,

Obrigado pela ajuda, depois, e com mais tempo, eu tb consegui criar uma macro que faz o que eu queria, vou compartilhar ela tb.

Código: Selecionar todos

Sub Separa_Copia_Cola_Arquivos()

Application.ScreenUpdating = False

Dim ws As Worksheet
Dim Conta_Linhas As Long
Dim j As Long
Dim Diretorio_Origem As String
Dim Diretorio_Destino As String
Dim Arquivo As String
    
'Diretorio_Origem = ThisWorkbook.Path + "\Sua_Pasta_Origem_dos_Arquivos\"
'Diretorio_Destino = ThisWorkbook.Path + "\Sua_Pasta_Destino_dos_Arquivos\"

NomePlan = ActiveSheet.Name
Set ws = ThisWorkbook.Worksheets(NomePlan)
With ws
                    Conta_Linhas = .Cells(Rows.Count, 7).End(xlUp).Row   'aqui o 7 é a coluna G
                    For j = 13 To Conta_Linhas - 1
                         Arquivo = Sheets(NomePlan).Range("G" & j) 'A lista dos arquivos esta na coluna G da planilha
                         Arquivo = Arquivo + ".xml"   'no meu caso copiei arquivos .xml, para outros é só mudar aqui
                         'Pasta com a origem dos arquivos
                         Diretorio_Origem = "D:\Sua_Pasta\Pasta1\Pasta2\Sua_Pasta_Origem_dos_Arquivos\"
                         'Pasta Destino dos arquivos
                         Diretorio_Destino = "D:\Sua_Pasta\Pasta1\Pasta2\Sua_Pasta_Destino_dos_Arquivos\"

                         Arquivo = Dir(Diretorio_Origem & Arquivo)
                         'MsgBox "Arquivo " & Arquivo
                         'MsgBox "Diretorio " & Diretorio_Origem
                            If Arquivo <> "" Then
                                FileCopy Diretorio_Origem & Arquivo, Diretorio_Destino & Arquivo
                            End If
                    Next j
End With
Application.ScreenUpdating = True
End Sub
Desde já agradeço !

Re: Macro para selecionar arquivos em uma Pasta !

Enviado: Qua Abr 14, 2021 9:23 am
por henriquealways
Bom dia, tudo bem?

Qual celulas eu colo as chaves para funcionar? eu preciso criar um botão para executar?