Excel VBA, Print a "Secured" PDF into a new unprotected PDF by using "Microsoft Print to PDF"

user_19852137 0
Viewed 42

I've created a macro to be able to import tables from a PDF, must be like 60 PDFs a day, but now I've discovered that those PDFs are protected so VBA can not access the information inside it. Unless if i print it as a new PDF.

I've gone as far as to be able to open the printing prompt, but because of the volume of information I need it to be more "automatic". I don't want to choose the Path where it will be saved or even it's name.

I have no idea on what should be my next steps This is the code that I'm using to open and print the PDF

   Option Explicit

   Private Declare PtrSafe Function ShellExecute Lib "shell32" Alias "ShellExecuteA" (ByVal hwnd As LongPtr, ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long

   Private Const SW_HIDE As Long = 0&
  
    Public Sub Print_PDFs()

   Dim caminho As String

   caminho = "C:\Users\93250121\Desktop\Tadeu\100722081309300_20563822_47774_20220824164855979_8.pdf"
               
               ShellExecute_Print caminho
  
   End Sub


   Public Sub ShellExecute_Print(file As String, Optional printerName As String)
   If printerName = "" Then
       ShellExecute Application.hwnd, "PrintTo", file, vbNullString, 0&, SW_HIDE
   Else
       ShellExecute Application.hwnd, "PrintTo", file, Chr(34) & printerName & Chr(34), 0&, SW_HIDE
   End If
   End Sub
printing vba excel pdf
1 Answers

I've been able to creat the code below that helped with the issue. so it's no longer necessary the first question.

Sub ler_tabela_via_query()

Dim Local_Arq As String
Dim Pasta As String
Dim fso As New FileSystemObject
Dim fo As Folder
Dim f As file

Set p_vba = ActiveWorkbook.Worksheets("Planilha2")
Set dados = ActiveWorkbook.Worksheets("Planilha1")


'Inerir onde serão armazenadas os PDF's
Pasta = "C:\Users\93250121\Desktop\Tadeu"

'A macro vai ler todos os arquivos que estiverem na pasta - então é essencial que na pasta só tenham arquivo em PDF que vocxê quer transferir
Set fo = fso.GetFolder(Pasta)

For Each f In fo.Files

'puxa o caminho inteiro do arquivo inclusivi o ".pdf"
Local_Arq = f.Path


'aciona a query puxando as tabeles 2 e 3 que contem respectivamente nome da empresa e informações da operação - Codigo está em M
  ActiveWorkbook.Queries.Add Name:="Table002 (Page 1)", Formula:= _
        "let" & Chr(13) & "" & Chr(10) & "    Fonte = Pdf.Tables(File.Contents(""" & Local_Arq & """), [Implementation=""1.3""])," & Chr(13) & "" & Chr(10) & "    Table002 = Fonte{[Id=""Table002""]}[Data]," & Chr(13) & "" & Chr(10) & "    #""Tipo Alterado"" = Table.TransformColumnTypes(Table002,{{""Column1"", type text}, {""Column2"", type text}})" & Chr(13) & "" & Chr(10) & "in" & Chr(13) & "" & Chr(10) & "    #""Tipo Alterado"""
    ActiveWorkbook.Queries.Add Name:="Table003 (Page 1)", Formula:= _
        "let" & Chr(13) & "" & Chr(10) & "    Fonte = Pdf.Tables(File.Contents(""" & Local_Arq & """), [Implementation=""1.3""])," & Chr(13) & "" & Chr(10) & "    Table003 = Fonte{[Id=""Table003""]}[Data]," & Chr(13) & "" & Chr(10) & "    #""Cabeçalhos Promovidos"" = Table.PromoteHeaders(Table003, [PromoteAllScalars=true])," & Chr(13) & "" & Chr(10) & "    #""Tipo Alterado"" = Table.TransformColumnTypes(#""Cabeçalhos Promo" & _
        "vidos"",{{""Característica"", type text}, {""Custódia"", type text}, {""Liquidação"", type text}, {""Datada#(lf)Contratação"", type text}, {""Vencimento"", type text}, {""Prazo (dias)"", Int64.Type}})" & Chr(13) & "" & Chr(10) & "in" & Chr(13) & "" & Chr(10) & "    #""Tipo Alterado"""
    
    p_vba.Activate
   With ActiveSheet.ListObjects.Add(SourceType:=0, Source:= _
        "OLEDB;Provider=Microsoft.Mashup.OleDb.1;Data Source=$Workbook$;Location=""Table002 (Page 1)"";Extended Properties=""""" _
        , Destination:=Range("$A$2")).QueryTable
        .CommandType = xlCmdSql
        .CommandText = Array("SELECT * FROM [Table002 (Page 1)]")
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .PreserveColumnInfo = True
        .Refresh
    End With
    
     p_vba.Activate
    With ActiveSheet.ListObjects.Add(SourceType:=0, Source:= _
        "OLEDB;Provider=Microsoft.Mashup.OleDb.1;Data Source=$Workbook$;Location=""Table003 (Page 1)"";Extended Properties=""""" _
        , Destination:=Range("$A$7")).QueryTable
        .CommandType = xlCmdSql
        .CommandText = Array("SELECT * FROM [Table003 (Page 1)]")
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .PreserveColumnInfo = True
        .Refresh
    End With
  
  ' sleep é uma chamada tipo wait mas melhor o codigo está definido lá em cima
 Sleep (100)
  
  ' Essa parte está no modulo 3 ele vai apagar todas as conexões do excel para poder puxar o proximo extrato
  Call DeleteAllQueriesAndConnections
  
  ' essa parte é sussa, ele só vai alinhar as informações e colar na aba padronizada
 p_vba.Activate
    Cells(1, 1) = Range("A3").Value
    Range("B1", "G1") = Range("A8", "F8").Value
    Range("H1", "L1") = Range("A10", "E10").Value
    Range("M1", "Q1") = Range("A12", "E12").Value
  
  p_vba.Columns("J:J").Select
    Selection.Delete Shift:=xlToLeft
    
 Range("A1").Select
 Range(Selection, Selection.End(xlToRight)).Copy
 
 dados.Activate
 Range("A100000").Select
 Selection.End(xlUp).Offset(1, 0).Select
 
 ActiveCell.PasteSpecial xlPasteValues
    
 p_vba.Columns("A:Z").Delete Shift:=xlToLeft
   
  
Next
  
End Sub
user_198521370
Related