Jump to content
gereiz

Renomear vários arquivos com VBA

Recommended Posts

Bom dia a todos. Adaptei um código para renomear vários arquivo com vba, que realiza a seguinte função:

 

1) Eu seleiono a pasta,

2) O VBA abre o PDF (Nota fiscal) , extrai a informação do texto e com a razão social fecha o pdf e renomeia ele com o nome extraido.

 

O problema é que após renomear o primeiro arquivo corretamente a execução do código trava, e é necessário finalizar o processo.

Segue abaixo o código.

Public Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As LongPtr)
Public Function ListaArquivos(ByVal Caminho As String) As String()
    

    'Atenção: Faça referência à biblioteca Micrsoft Scripting Runtime
    Dim FSO As New FileSystemObject
    Dim result() As String
    Dim Pasta As Folder
    Dim Arquivo As File
    Dim Indice As Long
 
 
    ReDim result(0) As String
    If FSO.FolderExists(Caminho) Then
        Set Pasta = FSO.GetFolder(Caminho)
 
        For Each Arquivo In Pasta.Files
            Indice = IIf(result(0) = "", 0, Indice + 1)
            ReDim Preserve result(Indice) As String
            result(Indice) = Arquivo.Name
        Next
    End If
 
    ListaArquivos = result
ErrHandler:
    Set FSO = Nothing
    Set Pasta = Nothing
    Set Arquivo = Nothing
End Function

Private Sub selecionar_pasta()
 Dim box As Folder
 Dim arquivos() As String
 Dim lCtr As Long
 Dim AdobeApp As String
 Dim StartAdobe
 Dim Arquivo As String
 Dim NomeAntigo As String
 Dim NomeNovo As String

 
     On Error Resume Next
     linha = 1
     ultima_linha = Sheets("teste").Cells(Rows.Count, 1).End(xlUp).Row
        
        With Application.FileDialog(msoFileDialogFolderPicker)
            .Title = "Buscar pasta"
            .InitialFileName = ThisWorkbook.Path
            .Show
            .AllowMultiSelect = False
            Pasta = .SelectedItems(1)
        End With
   
    TextBox1 = box
    

    arquivos = ListaArquivos(Pasta)
    Sleep 1000
    For lCtr = 0 To UBound(arquivos)
      Debug.Print arquivos(lCtr)
        'Inserir código aqui'
        
        'Cells(linha, 1).Value = arquivos(lCtr)
        'linha = (linha + 1)
        'Sleep 500
        
            
          pdf = arquivos(lCtr)
        
          AdobeApp = "C:\Program Files (x86)\Adobe\Acrobat Reader DC\Reader\AcroRd32.exe"
          
          Sleep 2000
          
          
        
          For Each pdf In Pasta
          
          
          Adobefile = Pasta & "\" & pdf
        
          StartAdobe = Shell("" & AdobeApp & " " & """" & Adobefile & """" & "", 1)
         
        
          Sleep 2000
              
            
            Application.SendKeys ("^a")

            Application.SendKeys ("^c")
             Sleep 2000

           
           
           Dim KillPdf As String

           KillPdf = "TASKKILL /F /IM AcroRd32.exe"
           Shell KillPdf, vbHide
           
                      
           AppActivate Application.Caption
        
        
            
            Sheets("teste").Range("A1").Activate
            SendKeys ("^v")
                     
            DoEvents
                
            
            
            
            Dim Razao As String


            Razao = Sheets("teste").Range("A17").Value
            pontos = InStr(1, Razao, ":")
            qtdeLetras = Len(Razao)
            Nome = Right(Razao, qtdeLetras - pontos)
            Sheets("teste").Range("C1").Value = Nome
            
            
            
            
              Do While Not IsEmpty(Range("C1"))
              
             
                NomeAntigo = Pasta & "\" & pdf
                    
                NomeNovo = Pasta & "\" & Sheets("teste").Range("C1").Value & ".pdf"
                
                Sheets("teste").Range("C2").Value = Adobefile
                    
                Sheets("teste").Range("C3").Value = Pasta & "\" & Sheets("teste").Range("C1").Value & ".pdf"
                    

                
                Name NomeAntigo As NomeNovo
                
                
               
               ' DoEvents
                
        
              Loop
    
   
   
         ' MsgBox "Nomes dos arquivos alterados!", vbOKOnly, "Processo Concluído"
            
            
        
            Next
        
        
    Next
    
     ' MsgBox ("Arquivos Encontrados = ") & (linha - 1)
     
     
      

End Sub

Já tentei de tudo, e não consegui resolver esse problema, se eu remover o Do while, ele executa normalmente, porem não renomeia os arquivos. Seu eu faço esse laço, ele renomeia só o primeiro e trava geral.

 

Qualquer esclarecimento, agradeço.


 

Share this post


Link to post
Share on other sites

Create an account or sign in to comment

You need to be a member in order to leave a comment

Create an account

Sign up for a new account in our community. It's easy!

Register a new account

Sign in

Already have an account? Sign in here.

Sign In Now

  • Similar Content

    • By Spy_brbr
      Tenho um sistema em PHP que funciona como um tipo de repositório para documentos. No início a ideia era apenas realizar pesquisas pelo título ou tipo de documento, mas andei lendo sobre algumas ferramentas como Apache Solr ou ElasticSearch que realizazam a indexação dos arquivos e permite realizar as buscas dentro de arquivos PDF, DOC, etc. Alguém já utilizou essas ferramentas ?
    • By asacap1000
      Salve Galera!!! estou com um projeto onde preciso disponibilizar na intranet documentos que estão em um servidor.
      Estes documentos estão salvos em diversas pastas dividido por dias meses e anos etc etc.
      Não quero que list todos os documentos porém ele seria pesquisado.
      Exemplo: NF 123456
      No arquivo salvaram assim "cliente NF 123456.pdf", tentei utilzar o glob porém ele não retorna nada nem deu erro.
      Por ser em outro servidor não seu se ele consegue ler já pesquisei mas não encontrei nada sobre isso.
       
      Saberiam me ajudar com este caso:
       
      Na intranet ele terá uma busca normal de relatórios ao listar essas informações ele diponibiliza um link com o numero da NF a qual eu chamaria essa página para realizar a busca no servidor e assim abrir o arquivo no navegador..
    • By sirrocha
      Oi pessoal, tenho uma dúvida referente a geração de PDFs automáticos em uma tabela.
      Gostaria de gerar um PDF para cada linha de uma tabela, contendo as informações que aparecem na interface, mas também as que estão dentro do banco de dados e preferi não mostrar pro usuário nessa parte. 
      Perguntei em um outro fórum, porém minha pergunta foi excluída, mas não estou procurando uma resposta pronta e sim uma indicação. Sou novo no assunto e por isso não tenho uma base tão sólida pra saber o caminho para eu iniciar.
       
      Tentei utilizar um padrão do dompdf, porém, aparentemente, a dica dada funcionava apenas para o CodeIgniter. O meu site está alocado no cPanel e eu usei o próprio editor de texto de lá para tudo que fiz até agora.
      Caso necessitem de mais informações, estou a disposição.
    • By asacap1000
      Galera já verifiquei vários páginas do google mas não encontrei o que precisava. Temos um sistema a qual no final temos a opção d imprimir os dados. que até aí está perfeito utilizo bootstrap para o layout e está ok. Porém preciso colocar a opção de pdf também aí não sai de jeito nenhum com o bootstrap. preciso gerar algo neste formato.
       

       
      Se alguem puder me dar um norte referente a isso agradeço demais.
    • By Guilherme Morete Felix
      Olá,
      Estamos upando arquivos em nossa plataforma via moodle, como base de regra, tais arquivos são em formato pdf.
      Temos como objetivo que o aluno apenas abra e visualize o documento, porém não consiga fazer o download, cópia, impressão ou algo no sentido mencionado.
      Caso não seja possível, uma saída secundária seria permitir a impressão dos arquivos com o cpf do aluno e um termo de compromisso como marca d'água.
      Alguém poderia me relatar se essas alternativas são possíveis, quais são as possibilidades e se alguma pessoa pode ajudar nesse aspecto? Desde já, muito obrigado!
×

Important Information

Ao usar o fórum, você concorda com nossos Terms of Use.