Import PDF do excelu Vyřešeno

[petr22]

Takovehle extra konvertovani bych zakaznikovi nauctoval, on se rychle nauci nepridelavat ostatnim
praci a zacne posilat v normalnim formatu. Stejne musi nekdo kontrolovat ze je to ve finalne spravne.

Toto se resi zverejnenim jakym zpusobem jsou objednavky prijimany a nic jineho neakceptovat.

Opakuji: Office 2021 umi import PDF. Zacal bych minimalne tim, ze stahnu zkusebni verzi a vyzkousim,
jestli nahodou neresi problem lepe, nez se pokouzet automatizovat konvertor.

[Reklama]

[ITCrowd]

Zapomínáš, že zákazník taky může jít jinam. A jestli dává 20 objednávek denně, tak bych si to hooodně rozmýšlel.
Off21 může být řešením.

[Grander]

Já jenom dodám, že hromadná automatická extrakce textových dat z PDF je opravdu rozšířeným úkonem (čili požadavek tazatele vůbec není nijak vyjímečný), takže na to existuje spousta návodů na netu (většinou se na to využívá Python, a chce to tomu trochu rozumět a věnovat tomu nějaký čas), připadně teď už jsou i online služby na bázi umělé inteligence, které to udělají automaticky, aniž by uživatel musel umět kodovat.

[petr22]

To je prave ten problem, je to zbytecna prace navic ktere se musi venovat cas. Nakonec
prijde dalsi zakaznik ktery nechce nic menit a ve finale mas 150 ruznych konvertoru, faxy,
potrubni postu a firemni staj kde jsou pripraveni cerstvi kone, protoze nekdo pouziva
pouze dostavniky.

To bych radsi naprogramoval webovou aplikaci, do ktere budou zakaznici vkladat zakazky,
ze ktere budou padat data automaticky ve spravnem formatu.

I ten Office 2021 je krok navic, kdy neodpada ta faze, kdy je nekdo placen za to, ze vizualne
zkontroluje vlozena data, o klikani navic nemluve. Cas jsou penize. Postup musi byt jednoduchy,
efektivni a nesmi dovolit udelat chybu.

I kdyby to byla 1 minuta na kazdy soubor, je to 20 zakazek denne, tedy 20 minut denne stravenych
pouze touto praci navic. 25 takovych zakazniku a uzivi jednoho cloveka na plny uvazek.

Office 365 lze vyzkouset na 1 mesic zdarma - a ten import PDF umi. Tedy mozno overit, ze je to reseni.

[luko02420]

Dobrý večer,
doma mám na nt office 365, tak jsem zkusil nahrát kód a importovat zmíněné pdf.
Vše proběhlo v pohodě veškerá data se načetla.
Teď akorát musím nějak ten nahrátý kód upravit, aby mě načetl všechny pdf soubory, a abych nemusel používat proměnou v názvu a makro načítat opakovaně.
Taky nevím jak odstranit propojení z načtených dat.

Kód: Vybrat vše

Sub pdf()
'
' pdf Makro
'

'
    ActiveWorkbook.Queries.Add Name:="Page001", Formula:= _
        "let" & Chr(13) & "" & Chr(10) & "    Zdroj = Pdf.Tables(File.Contents(""C:\Users\luko02420\Documents\23172.pdf""), [Implementation=""1.3""])," & Chr(13) & "" & Chr(10) & "    Page1 = Zdroj{[Id=""Page001""]}[Data]," & Chr(13) & "" & Chr(10) & "    #""Změněný typ"" = Table.TransformColumnTypes(Page1,{{""Column1"", type text}, {""Column2"", type text}, {""Column3"", type text}, {""Column4"", type text}, {""Column5"", type text}})" & Chr(13) & "" & Chr(10) & "in" & Chr(13) & "" & Chr(10) & "    #""Změněný typ"""
    ActiveWorkbook.Worksheets.Add
    With ActiveSheet.ListObjects.Add(SourceType:=0, Source:= _
        "OLEDB;Provider=Microsoft.Mashup.OleDb.1;Data Source=$Workbook$;Location=Page001;Extended Properties=""""" _
        , Destination:=Range("$A$1")).QueryTable
        .CommandType = xlCmdSql
        .CommandText = Array("SELECT * FROM [Page001]")
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .BackgroundQuery = True
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .PreserveColumnInfo = True
        .ListObject.DisplayName = "Page001_2"
        .Refresh BackgroundQuery:=False
    End With
    Range("A4").Select
End Sub

[elninoslov]

Kód: Vybrat vše

Sub pdf()
Dim Cesta As String, Con As WorkbookConnection

    Cesta = "C:\Users\luko02420\Documents\"
   
    With ThisWorkbook
        On Error Resume Next
        .Queries("ObjednavkyPDF").Delete    'zmazať prípadný predchádzajúci dotaz PQ
        On Error GoTo 0
       
        'vytvorenie PowerQuery dorazu
        .Queries.Add Name:="ObjednavkyPDF", Formula:="let" & vbCrLf _
        & "    Zdroj = Folder.Files(""" & Cesta & """)," & Chr(13) & Chr(10) _
        & "    #""Text napísaný malými písmenami"" = Table.TransformColumns(Zdroj,{{""Extension"", Text.Lower, type text}})," & vbCrLf _
        & "    #""Filtrované skryté súbory"" = Table.SelectRows(#""Text napísaný malými písmenami"", each [Attributes]?[Hidden]? <> true and [Extension]="".pdf"")," & vbCrLf _
        & "    #""Odstránené ostatné stĺpce"" = Table.SelectColumns(#""Filtrované skryté súbory"",{""Content"", ""Name""})," & vbCrLf _
        & "    #""Vyvolať vlastnú funkciu"" = Table.AddColumn(#""Odstránené ostatné stĺpce"", ""Transformovať súbor"", each Pdf.Tables([Content], [Implementation=""1.3""]){[Id=""Page001""]}[Data])," & vbCrLf _
        & "    #""Rozbalené Transformovať súbor"" = Table.ExpandTableColumn(#""Vyvolať vlastnú funkciu"", ""Transformovať súbor"", {""Column1"", ""Column2"", ""Column3"", ""Column4"", ""Column5""}, {""Column1"", ""Column2"", ""Column3"", ""Column4"", ""Column5""})," & vbCrLf _
        & "    #""Odstránené stĺpce"" = Table.RemoveColumns(#""Rozbalené Transformovať súbor"",{""Content""})," & vbCrLf _
        & "    #""Změněný typ"" = Table.TransformColumnTypes(#""Odstránené stĺpce"",{{""Name"", type text}, {""Column1"", type text}, {""Column2"", type text}, {""Column3"", type text}, {""Column4"", type text}, {""Column5"", type text}})" & vbCrLf _
        & "in" & vbCrLf _
        & "    #""Změněný typ"""
    End With
   
    With wsObjednavkyPDF
        .Cells.Clear    'vymazanie predchádzajúcej tabuľky

        'vytvorenie Tabuľky a pripojenia na dotaz PQ
        With .ListObjects.Add(SourceType:=0, _
                              Source:="OLEDB;Provider=Microsoft.Mashup.OleDb.1;Data Source=$Workbook$;Location=ObjednavkyPDF;Extended Properties=""""", _
                              Destination:=wsObjednavkyPDF.Range("$A$1")).QueryTable
            .CommandType = xlCmdSql
            .CommandText = Array("SELECT * FROM [ObjednavkyPDF]")
            .RowNumbers = False
            .FillAdjacentFormulas = False
            .PreserveFormatting = True
            .RefreshOnFileOpen = False
            .BackgroundQuery = True
            .RefreshStyle = xlInsertDeleteCells
            .SavePassword = False
            .SaveData = True
            .AdjustColumnWidth = True
            .RefreshPeriod = 0
            .PreserveColumnInfo = True
            .ListObject.DisplayName = "tblObjednavkyPDF"
            .Refresh BackgroundQuery:=False
        End With
       
        'zrušenie Tabuľky
        With .ListObjects("tblObjednavkyPDF")
            .TableStyle = ""
            .Unlink
            .Unlist
        End With
        Application.Goto .Range("A1"), True 'skok na výsledok
    End With

    'vymazanie pripojení na dotaz PQ
    With ThisWorkbook
        .Queries("ObjednavkyPDF").Delete
        For Each Con In .Connections
            If InStr(1, Con.OLEDBConnection.Connection, "Location=ObjednavkyPDF") > 0 Then Con.Delete
        Next Con
    End With

    Set Con = Nothing
End Sub

[luko02420]

Dobrý den,
ještě jednou děkuji, dělá přesně to co potřebuji. Zlaté ruce.