ATENÇÃO NOVOS USUÁRIOS

Se registrou recentemente? Seu cadastro será avaliado e mendiante aprovação, a conta será ativada e você poderá usufruir do fórum. O tempo de avaliação gira em torno de 24 a 48 horas.

Esqueceu sua senha?

Você pode usar o mecanismo de lembrete neste link: Recuperar senha

Você receberá um link de reativação no email cadastrado.

Não recebeu o email? Lembre-se checar o Lixo Eletrônico.

Macro para selecionar arquivos em uma Pasta !

Dúvidas gerais sobre Excel
AndersonDorneles
Colaborador
Colaborador
Mensagens: 21
Registrado em: Ter Mai 03, 2011 7:58 am

Macro para selecionar arquivos em uma Pasta !

Mensagem por AndersonDorneles » Qua Jan 23, 2019 11:05 am

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



Disable adblock

This site is supported by ads and donations.
If you see this text you are blocking our ads.
Please consider a Donation to support the site.


Avatar do usuário
PRMPOKER
Consultor
Consultor
Mensagens: 200
Registrado em: Ter Dez 04, 2012 8:57 am

Re: Macro para selecionar arquivos em uma Pasta !

Mensagem por PRMPOKER » 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!



Paulinho Monteiro
VBA - Front/BackEnd Developer

Email: falecom@paulinhomonteiro.com
falecompaulinhomonteiro@gmail.com
Whatsapp (54) 9925 340 85
www.paulinhomonteiro.com

AndersonDorneles
Colaborador
Colaborador
Mensagens: 21
Registrado em: Ter Mai 03, 2011 7:58 am

Re: Macro para selecionar arquivos em uma Pasta !

Mensagem por AndersonDorneles » Qua Jan 23, 2019 2:28 pm

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



Avatar do usuário
PRMPOKER
Consultor
Consultor
Mensagens: 200
Registrado em: Ter Dez 04, 2012 8:57 am

Re: Macro para selecionar arquivos em uma Pasta !

Mensagem por PRMPOKER » Qui Jan 24, 2019 11:41 am

Prezados, boa tarde.

Caro AndersonDorneles, tudo bem?

Perfeito. Qualquer coisa, estamos às ordens.

Um abraço.



Paulinho Monteiro
VBA - Front/BackEnd Developer

Email: falecom@paulinhomonteiro.com
falecompaulinhomonteiro@gmail.com
Whatsapp (54) 9925 340 85
www.paulinhomonteiro.com

Disable adblock

This site is supported by ads and donations.
If you see this text you are blocking our ads.
Please consider a Donation to support the site.


Avatar do usuário
Reinaldo
Jedi
Jedi
Mensagens: 1381
Registrado em: Sex Ago 01, 2014 4:09 pm
Localização: Garça - SP / SCS - SP

Re: Macro para selecionar arquivos em uma Pasta !

Mensagem por Reinaldo » 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


Reinaldo
:oops: :D :mrgreen: :geek:

AndersonDorneles
Colaborador
Colaborador
Mensagens: 21
Registrado em: Ter Mai 03, 2011 7:58 am

Re: Macro para selecionar arquivos em uma Pasta !

Mensagem por AndersonDorneles » Sex Jan 25, 2019 9:19 am

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 !



Disable adblock

This site is supported by ads and donations.
If you see this text you are blocking our ads.
Please consider a Donation to support the site.


Responder