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 Kefatif
      Prezados, boa tarde!
       
      Em uma tela faço o envio de arquivos PDF para uma pasta reservada para isso.
       
      Estou tendo dificuldade para criar um botão de download na tela de consultas, quando abro a página de consulta ele está me mostrando a seguinte mensagem: "Notice: Undefined variable: row in C:\xampp\htdocs\plataforma\indicadores\consultar.php on line 126"
       
      Podem me ajudar?
       
      <?php include_once 'autenticacao.php'; include_once'../conexao.php'; ?> <!DOCTYPE html> <html lang="pt-br"> <head> <meta charset="utf-8"> <meta http-equiv="X-UA-Compatible" content="IE=edge"> <meta name="viewport" content="width=device-width, initial-scale=1"> <meta name="description" content=""> <meta name="author" content=""> <title>Envio de Ata</title> <link href="../css/estilo.css" rel="stylesheet"> <!-- Bootstrap Core CSS --> <link href="../css/bootstrap.css" rel="stylesheet"> <!-- Custom CSS --> <link href="../css/modern-business.css" rel="stylesheet"> <!-- Custom Fonts --> <link href="../font-awesome/css/font-awesome.min.css" rel="stylesheet" type="text/css"> <script src="../js/jquery.min.js"></script> </head> <body> <?php include_once 'nav-menu1.php'; ?> <!-- Page Content --> <div class="container" style="width: 90%"> <?php include_once 'cabecalho.php'; ?> <div class="row"> <?php include_once 'barra-lateral.php'; ?> <!-- Content Column --> <div class="col-md-9" style="width: 80%"> <h4><b>CONSULTAR UNIDADE</b></h4> <form class="form-inline" action="consultar.php" autocomplete="off" method="get"> <div id="form-callcenter"> <label style="width: 30%"> <input type="text" name="nome" class="form-control" placeholder="Digite o nome da unidade" style="width: 100%"> </label> <input type="submit" readonly value="Pesquisar" class="btn btn-primary"> </div> </form> <?php if (isset($_GET["nome"]) ) { $nome = $_GET["nome"]; include_once '../funcoes.php'; $sql = "select A.dt_envio, A.unidade, A.responsavel, A.observacao, A.anexo from controle_ata A where A.unidade like '%".$nome."%' order by A.dt_envio desc"; $result = mysqli_query($con, $sql); if (mysqli_num_rows($result) > 0) { ?> <table class="table table-hover table-bordered" id="tabela-dispensacao2"> <tr> <th>Unidade</th> <th>Data do envio</th> <th>Responsável</th> <th>Observação</th> <th>Ata</th> <th>Download</th> </tr> <?php if($row["anexo"] == ''){ $cor = "red"; }else{ $cor = "blue"; } while ($row = mysqli_fetch_array($result)){ foreach($row as $key => $values){ $row[$key]= utf8_encode($values); } ?> <tr> <td><?php echo $row["unidade"]?></td> <td><?php echo dataTela($row["dt_envio"]); ?></td> <td><?php echo $row["responsavel"]; ?></td> <td><?php echo $row["observacao"] ?></td> <td><?php echo $row["anexo"] ?></td> <td><a class="<?php if($row["ANEXO"] == ''){echo "link-nao-ativo";}?>" href='anexos/<?php echo $row["ANEXO"] ?>' target="_blank"> <i style="color:<?php echo $cor ?>" class="glyphicon glyphicon-download-alt"></i> </a> </td> </tr> <?php }//ENCERRANDO O WHILE ?> </table> <?php }else{ echo "Nenhuma unidade encontrada!<br>"; } } ?> <?php mysqli_close($con); ?> </div> </div> <!-- /.row --> </div> <!-- /.container --> <!-- jQuery --> <script src="../js/jquery.js"></script> <!-- Bootstrap Core JavaScript --> <script src="../js/bootstrap.min.js"></script> </body> </html>  
       
      Agradeço a ajuda desde já!
    • By Mauricio Molina
      Ola pessoal,
       
      Estou com probleminha, preciso gerar um PDF de alguns dados do BD, até consegui gerar o PDF (quando especifico o id), mas preciso que ao clicar no botão corresponde de uma lista de ordem de serviço, o PDF seja gerado de acordo com o ID da ordem de serviço.
       

       
      Botão:
      <a type="button" class="btn btn-sm btn-info" href="gerar_pdf.php?id=<?php echo $rows_cursos['id']; ?>" target="_blank" >PDF</a> Gerar PDF:
      <?php include ('pdf/mpdf.php'); include_once("../conexao/conexao.php"); //Criar a conexão $conn = mysqli_connect($servidor, $usuario, $senha, $dbname); if(!$conn){ die("Falha na conexao: " . mysqli_connect_error()); }else{ //echo "Conexao realizada com sucesso"; } $id = '17'; //***Aqui seria onde busca o ID da Ordem de Serviço*** $result_usuario = "SELECT * FROM ordem_servico WHERE id = '$id' LIMIT 1"; $resultado_usuario = mysqli_query($conn, $result_usuario); $row_usuario = mysqli_fetch_assoc($resultado_usuario); $pagina = "<html> <body> <h2>Ordem de Serviço Eletrobrastec</h2><p></p> <strong>Empresa:</strong> Eletrobrastec                                          <strong>Data:</strong> ".$row_usuario['date']."              <strong>Número OS:</strong> ".$row_usuario['id']." <p></p> <strong>Edereço:</strong> Rua Santo Agostinho, 860            <strong>Bairro:</strong> Caiçara        <strong>Cidade:</strong> Praia Grande       <strong>UF:</strong> SP <p></p> <strong>CNPJ:</strong> 288.880.270/0018-1         <strong>DD:</strong> 13         <strong>Telefone:</strong> 99757-6400 <hr> <h2>Dados do Cliente</h2> <p></p> <strong>Nome:</strong> ".$row_usuario['nome']."                                          <strong>Data Execução:</strong> _______________________ <p></p> <strong>DD:</strong> ".$row_usuario['dd']."                       <strong>Telefone:</strong> ".$row_usuario['telefone']."               <strong>E-mail:</strong> ".$row_usuario['email']." <p></p> <strong>CPF:</strong> ".$row_usuario['cpf']."               <strong>CNPJ:</strong> ".$row_usuario['cnpj']." <p></p> <strong>Aparelho:</strong> ".$row_usuario['aparelho']."                 <strong>Modelo:</strong> ".$row_usuario['modelo']."                  <strong>Defeito:</strong> ".$row_usuario['defeito']." <p></p> <strong>Taxa:</strong> _______________________                       <strong>Valor Total:</strong> ".$row_usuario['v_total']." <p></p> <strong>Descrição Serviço:</strong> ".$row_usuario['desc_servico']." <p></p><p></p><p></p><p></p><p></p><p></p><p></p> <strong>Observações:</strong> _____________________________________________________________________________________________________ _____________________________________________________________________________________________________ _____________________________________________________________________________________________________ _____________________________________________________________________________________________________ _____________________________________________________________________________________________________ _____________________________________________________________________________________________________ <p></p><p></p><p></p><p></p> <label>*A taxa de visita apenas será cobrada caso o cliente não realize o serviço, caso não queira e posteriormente venha realizar, a mesma será descontada.<label> </body> </html> "; $arquivo = "ordemservico.pdf"; $mpdf = new mPDF(); $mpdf->WriteHTML($pagina); $mpdf->Output($arquivo, 'I'); // I - Abre no navegador // F - Salva o arquivo no servido // D - Salva o arquivo no computador do usuário ?> Neste caso percebem que esta sendo gerado um PDF com a ordem de serviço de ID 17, tudo correto, porem gostaria que neste item, fosse gerado de acordo com o botão clicado.
       
      $id = '17'; //***Aqui seria onde busca o ID da Ordem de Serviço*** $result_usuario = "SELECT * FROM ordem_servico WHERE id = '$id' LIMIT 1"; $resultado_usuario = mysqli_query($conn, $result_usuario); $row_usuario = mysqli_fetch_assoc($resultado_usuario);  
      Alguém pra dar uma força?
       
      Obrigado!
       
       
    • By Pedro_Gomes
      Sou estudante de Programação e nunca tinha usado VBA e tenho de entregar um trabalho, mas nunca tive formação nesta linguagem, e estou a ter problemas  no programa na parte de Pesquisar registros com filtros, já tentei ao máximo fazer seguindo tutoriais na internet, até que uma pessoua me ajudou e mandou-me codia e disse para fazer um passos só que eu nao sei seguir esses passos.
       Fico muito agradecido se alguém me conseguir ajudar.
         
      O que a pessoa me indicou:
      " Para testar o código coloque um filtro na planilha Dados no range A1:L1 e crie uma planilha com o nome de Auxiliar. Cole o código no formulário Pesquisar. "
       
      Option Explicit Private Sub TextBox1_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer) If KeyCode = 13 Then Call Filtro(TextBox1.Text, ComboBox1.Text) End Sub Private Sub TextBox2_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer) If KeyCode = 13 Then Call Filtro(TextBox2.Text, ComboBox2.Text) End Sub Private Sub TextBox3_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer) If KeyCode = 13 Then Call Filtro(TextBox3.Text, ComboBox3.Text) End Sub Private Sub UserForm_Initialize() ComboBox1.RowSource = "Relatório!A1:A12" ComboBox2.RowSource = "Relatório!A1:A12" ComboBox3.RowSource = "Relatório!A1:A12" End Sub Sub Filtro(ByVal Pesquisa As String, Campo As String) Dim Coluna As Integer Dim Area As Range Set Area = ThisWorkbook.Sheets("Dados").[A1:L1] Coluna = WorksheetFunction.Match(Campo, Area, 0) If Pesquisa <> "" Then If IsNumeric(Pesquisa) = False Then Pesquisa = "*" & Pesquisa & "*" Call Area.AutoFilter(Field:=Coluna, Criteria1:=Pesquisa) Call CopiaTabela Call PreencheListBox End If End Sub Sub CopiaTabela() ThisWorkbook.Sheets("Auxiliar").[A:L].Clear ThisWorkbook.Sheets("Dados").[A1].CurrentRegion.Copy ThisWorkbook.Sheets("Auxiliar").[A1].PasteSpecial xlPasteValues Application.CutCopyMode = False End Sub Sub PreencheListBox() Dim Area As Range Set Area = ThisWorkbook.Sheets("Auxiliar").[A1].CurrentRegion ListBox1.ColumnCount = Area.Columns.Count ListBox1.ColumnHeads = True ListBox1.RowSource = "Auxiliar!" & Area.Offset(1).Address End Sub Link do Programa: 
      https://drive.google.com/file/d/1ucJVL5Ijg0IcDqaFzoJi8aiMPb0NCbjI/view?usp=sharing
    • By Kefatif
      Prezados, bom dia.
       
      Tenho uns um sistema com uns relatórios em PDF na pasta do meu domínio onde chamo pelo comando abaixo:

                 
      <div class="row">             <div class="col-md-4 img-portfolio">                 <a href="relatorios/teste.pdf" target="_blank">                 <img class="img-responsive img-hover" src="../img/jan-700x400.jpg" alt=""></a><h3>                 <center><a href="relatorios-teste/relatorios-producao.php">Janeiro/2021</a></center></h3>             </div>  
      Mas se uma pessoa acessar o PDF, copiar o link e enviar para uma outra pessoa que não tem acesso ao sistema, essa pessoa não autorizada terá acesso a esses relatórios, existe alguma forma para restringir esse acesso?
       
      Uso a autenticação da seguinte forma.
       
      Arquivo "Autenticação":
       
      <?php session_start(); //se não(!) existir a sessao login if(!isset($_SESSION["nome"])){ session_destroy(); $msg = "Acesso negado!"; header("location:../login.php?msg=".$msg); }elseif( $_SESSION["perfil"] != 'relatorios' ){ $msg = "Acesso negado!"; header("location:../painel.php?msg=".$msg); } ?>  
       
      Agradeço a todos desde já.
×

Important Information

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