• DİKKAT

    DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
    Altın Üyelik Hakkında Bilgi

Soru PDF dosyasından veriyi sistematik şekilde excel dosyasına almak

seckinb

seckinb

Katılım
9 Aralık 2018
Mesajlar
363
Excel Vers. ve Dili
Excel 2019 - 32 bit TR
Merhaba,
Pdf dosyasında kimlik bilgileri ve raporların olduğu 100 civarı dosyam var.
Bunları farklı farklı hücrelere gelecek şekilde import etmek istiyorum.

Nasıl yapabilirim?

  • Hasta adı
  • Hasta soyadı
  • Protokol no
  • Sut kodu
  • Çekim Tarihi
  • Bölüm
  • Cinsiyet
  • Yaş
  • Endikasyon
  • Bulgular
  • Sonuç
Bilgileri toplu halde bu 100 PDF'den çekmeyi planlıyorum.
Teşekkürler
 

Ekli dosyalar

seckinb' Alıntı:
Merhaba,
Pdf dosyasında kimlik bilgileri ve raporların olduğu 100 civarı dosyam var.
Bunları farklı farklı hücrelere gelecek şekilde import etmek istiyorum.

Nasıl yapabilirim?


  • Hasta adı
  • Hasta soyadı
  • Protokol no
  • Sut kodu
  • Çekim Tarihi
  • Bölüm
  • Cinsiyet
  • Yaş
  • Endikasyon
  • Bulgular
  • Sonuç
Bilgileri toplu halde bu 100 PDF'den çekmeyi planlıyorum.
Teşekkürler
Genişletmek için tıkla ...

Fikir olarak tüm pdf leri birleştirip tek excele döndürüp kapalı excelden veri çekmeyi sağlayabilirsin yada her pdf i excele çevirerek yapabilirsin
 
Kişisel bilgileri uluorta koymanız doğru değil.
 
Word dokümanındaki şablon sabitse olabilir, yok sabit değil de ..... çeşitli varyasyonları varsa yani, not almak üzere hazırlanmış gibi raporlama sistemiyse o zaman "tipik" bir kod hazırlamak zor olur.

.
 
Haluk' Alıntı:
Word dokümanındaki şablon sabitse olabilir, yok sabit değil de ..... çeşitli varyasyonları varsa yani, not almak üzere hazırlanmış gibi raporlama sistemiyse o zaman "tipik" bir kod hazırlamak zor olur.

.
Genişletmek için tıkla ...


Haluk bey, doğrusu uzun zaman önce
"GetData_PDF_6_RegExp" ile bir dosya hazırlamıştınız.
Bu pdf'de format değişti.
Kendim modifiye etmeye çalıştım ama başaramadım.
 
Uyarınızı dikkate aldım.
Uğraştığım dosyayı eklentilerini ulaştırıyorum.
 

Ekli dosyalar

Haluk' Alıntı:
Word dokümanındaki şablon sabitse olabilir, yok sabit değil de ..... çeşitli varyasyonları varsa yani, not almak üzere hazırlanmış gibi raporlama sistemiyse o zaman "tipik" bir kod hazırlamak zor olur.

.
Genişletmek için tıkla ...

Şablon sabit,
tüm raporlar bir uygulama tarafından tipik şekilde oluşturuluyor.

Sizin daha önce hazırladığınız kod üzerinden deniyorum ama henüz hiç import edemedim.


PHP: 
Sub import_kod()
    
    Dim FSO As Object, dosya As Variant, pdfDoc As PDFDocument, pages As PDFPageCollection
    Dim t As Byte
    Dim RegExp As Object, valData As Variant, RetVal As Variant
    Dim arrPattern(1 To 11) As String
    Dim txtPDF As String, tempData As String, strAd As String, strSOYAD As String
    Dim NoA As Integer, i As Integer, arrIndex As Integer
    

    Set FSO = CreateObject("Scripting.FileSystemObject")
    Set WS = CreateObject("WScript.Shell")
    desk = WS.SpecialFolders("Desktop")
    folderpath = desk & "\pdf"

    
    i = 1
    For Each dosya In FSO.GetFolder(folderpath).Files
        If LCase(FSO.GetExtensionName(dosya)) = "pdf" Then
            NoA = Range("A" & Rows.Count).End(xlUp).Row + 1
            Set pdfDoc = New PDFDocument
            Set pages = pdfDoc.OpenPdf(dosya)
            
            For t = 0 To pages.Count - 1
                txtPDF = txtPDF & WorksheetFunction.Trim(pages(t).GetText) & vbCrLf
            Next
            
            arrPattern(1) = "Hasta Adı\s{1}(.+)"
            arrPattern(2) = "Hasta Soyadı\s{1}(.+)"
            arrPattern(3) = "Protokol No\s{1}(.+)"
            arrPattern(4) = "Çekim T\s{1}?arihi\s{1}(\d{1,2}\.\d{1,2}\.\d{4})"
            arrPattern(5) = "Bölüm\s{1}(.+)"
            arrPattern(6) = "Cinsiyet\s{1}(.+)"
            arrPattern(7) = "Bölüm\s{1}(.+)"
            arrPattern(8) = "Yaş\s{1}(.+)"
            arrPattern(9) = "ENDİKASYON\s{1}(.+)"
            arrPattern(10) = "BULGULAR\s{1}(.+)"
            arrPattern(11) = "SONUÇ\s{1}(.+)"
            Set RegExp = CreateObject("VBScript.RegExp")
            
            RegExp.IgnoreCase = True
'            regExp.MultiLine = True
            RegExp.Global = True
            
            i = Range("A" & Rows.Count).End(xlUp).Row
            arrIndex = 0
            For Each valData In arrPattern
                RegExp.Pattern = valData
                arrIndex = arrIndex + 1
                If RegExp.Test(txtPDF) Then
                    For Each RetVal In RegExp.Execute(txtPDF)
                        tempData = RetVal.Submatches(0)
                        If arrIndex = 1 Then
                            Range("B" & i) = tempData
                        ElseIf arrIndex = 2 Then
                            Range("C" & i) = tempData
                        ElseIf arrIndex = 3 Then
                            Range("D" & i) = RemoveExtraChars(tempData) + 0
                        ElseIf arrIndex = 4 Then
                            Range("E" & i) = tempData
                        ElseIf arrIndex = 5 Then
                            Range("F" & i) = tempData
                        ElseIf arrIndex = 6 Then
                            Range("G" & i) = tempData
                        ElseIf arrIndex = 7 Then
                            Range("H" & i) = tempData
                        ElseIf arrIndex = 8 Then
                            Range("I" & i) = RemoveExtraChars(tempData) + 0
                        ElseIf arrIndex = 9 Then
                            Range("J" & i) = tempData
                        ElseIf arrIndex = 10 Then
                            Range("K" & i) = tempData
                        ElseIf arrIndex = 11 Then
                            Range("L" & i) = tempData
                        End If
                    Next
                End If
            Next
        End If
        txtPDF = ""
    Next
    Set RegExp = Nothing
    pdfDoc.ClosePdf
    Set pages = Nothing
    Set pdfDoc = Nothing
    Set FSO = Nothing
End Sub

Function RemoveExtraChars(ByVal xStr As String) As String
    Dim i As Integer
    Dim RegExp As Object
    Set RegExp = CreateObject("VBScript.RegExp")
    With RegExp
        .Global = True
        .MultiLine = False
        .IgnoreCase = True
        .Pattern = "[^0-9\,]"
    End With
    RemoveExtraChars = Application.WorksheetFunction.Trim(RegExp.Replace(xStr, ""))
    Set RegExp = Nothing
End Function
 
Birkaç tanesi için şöyle örnek olsun....

C#: 
Sub import_kod()
    
    Dim FSO As Object, dosya As Variant, pdfDoc As PDFDocument, pages As PDFPageCollection
    Dim t As Byte
    Dim RegExp As Object, valData As Variant, RetVal As Variant
    Dim arrPattern(1 To 7) As String
    Dim txtPDF As String, tempData As String, strAd As String, strSOYAD As String
    Dim NoA As Integer, i As Integer, arrIndex As Integer
    

    Set FSO = CreateObject("Scripting.FileSystemObject")
    Set WS = CreateObject("WScript.Shell")
    desk = WS.SpecialFolders("Desktop")
    folderpath = desk & "\pdf"
    
    i = 1
    For Each dosya In FSO.GetFolder(folderpath).Files
        If LCase(FSO.GetExtensionName(dosya)) = "pdf" Then
            NoA = Range("A" & Rows.Count).End(xlUp).Row + 1
            Set pdfDoc = New PDFDocument
            Set pages = pdfDoc.OpenPdf(dosya)
            
            For t = 0 To pages.Count - 1
                txtPDF = txtPDF & WorksheetFunction.Trim(pages(t).GetText) & vbCrLf
            Next
            
            arrPattern(1) = "Hasta Adı:(.+)Çekim Tarih:"
            arrPattern(2) = "Hasta Soyadı:(.+)Bölüm:"
            arrPattern(3) = "Çekim Tarih:(.+)"
            arrPattern(4) = "Protokol No:(.+)"
            arrPattern(5) = "Cinsiyet:(.+)"
            arrPattern(6) = "Tetkik:(.+)"
            arrPattern(7) = "ENDİKASYON:(.+)"
            
            Set RegExp = CreateObject("VBScript.RegExp")
            
            RegExp.IgnoreCase = True
            RegExp.Global = True
            
            i = Range("A" & Rows.Count).End(xlUp).Row
            arrIndex = 0
            For Each valData In arrPattern
                RegExp.Pattern = valData
                arrIndex = arrIndex + 1
                If RegExp.Test(txtPDF) Then
                    For Each RetVal In RegExp.Execute(txtPDF)
                        tempData = RetVal.Submatches(0)
                        If arrIndex = 1 Then
                            Range("A" & i) = tempData
                        ElseIf arrIndex = 2 Then
                            Range("B" & i) = tempData
                        ElseIf arrIndex = 3 Then
                            Range("C" & i) = tempData
                        ElseIf arrIndex = 4 Then
                            Range("D" & i) = tempData
                        ElseIf arrIndex = 5 Then
                            If LCase(Right(temp, 3)) = "kek" Then
                                Range("E" & i) = "Erkek"
                            Else
                                Range("E" & i) = "Kadın"
                            End If
                        ElseIf arrIndex = 6 Then
                            Range("F" & i) = tempData
                        ElseIf arrIndex = 7 Then
                            Range("G" & i) = tempData
                        End If
                    Next
                End If
            Next
        End If
        txtPDF = ""
    Next
    Set RegExp = Nothing
    pdfDoc.ClosePdf
    Set pages = Nothing
    Set pdfDoc = Nothing
    Set FSO = Nothing
End Sub


.
 
Haluk' Alıntı:
Birkaç tanesi için şöyle örnek olsun....

C#: 
Sub import_kod()
   
    Dim FSO As Object, dosya As Variant, pdfDoc As PDFDocument, pages As PDFPageCollection
    Dim t As Byte
    Dim RegExp As Object, valData As Variant, RetVal As Variant
    Dim arrPattern(1 To 7) As String
    Dim txtPDF As String, tempData As String, strAd As String, strSOYAD As String
    Dim NoA As Integer, i As Integer, arrIndex As Integer
   

    Set FSO = CreateObject("Scripting.FileSystemObject")
    Set WS = CreateObject("WScript.Shell")
    desk = WS.SpecialFolders("Desktop")
    folderpath = desk & "\pdf"
   
    i = 1
    For Each dosya In FSO.GetFolder(folderpath).Files
        If LCase(FSO.GetExtensionName(dosya)) = "pdf" Then
            NoA = Range("A" & Rows.Count).End(xlUp).Row + 1
            Set pdfDoc = New PDFDocument
            Set pages = pdfDoc.OpenPdf(dosya)
           
            For t = 0 To pages.Count - 1
                txtPDF = txtPDF & WorksheetFunction.Trim(pages(t).GetText) & vbCrLf
            Next
           
            arrPattern(1) = "Hasta Adı:(.+)Çekim Tarih:"
            arrPattern(2) = "Hasta Soyadı:(.+)Bölüm:"
            arrPattern(3) = "Çekim Tarih:(.+)"
            arrPattern(4) = "Protokol No:(.+)"
            arrPattern(5) = "Cinsiyet:(.+)"
            arrPattern(6) = "Tetkik:(.+)"
            arrPattern(7) = "ENDİKASYON:(.+)"
           
            Set RegExp = CreateObject("VBScript.RegExp")
           
            RegExp.IgnoreCase = True
            RegExp.Global = True
           
            i = Range("A" & Rows.Count).End(xlUp).Row
            arrIndex = 0
            For Each valData In arrPattern
                RegExp.Pattern = valData
                arrIndex = arrIndex + 1
                If RegExp.Test(txtPDF) Then
                    For Each RetVal In RegExp.Execute(txtPDF)
                        tempData = RetVal.Submatches(0)
                        If arrIndex = 1 Then
                            Range("A" & i) = tempData
                        ElseIf arrIndex = 2 Then
                            Range("B" & i) = tempData
                        ElseIf arrIndex = 3 Then
                            Range("C" & i) = tempData
                        ElseIf arrIndex = 4 Then
                            Range("D" & i) = tempData
                        ElseIf arrIndex = 5 Then
                            If LCase(Right(temp, 3)) = "kek" Then
                                Range("E" & i) = "Erkek"
                            Else
                                Range("E" & i) = "Kadın"
                            End If
                        ElseIf arrIndex = 6 Then
                            Range("F" & i) = tempData
                        ElseIf arrIndex = 7 Then
                            Range("G" & i) = tempData
                        End If
                    Next
                End If
            Next
        End If
        txtPDF = ""
    Next
    Set RegExp = Nothing
    pdfDoc.ClosePdf
    Set pages = Nothing
    Set pdfDoc = Nothing
    Set FSO = Nothing
End Sub


.
Genişletmek için tıkla ...

Enteresan şekilde hiç import etmedi
 
Verilen örnek PDF üzerinde çalıştı....

.
 
@seckinb hocam ekte buluna; iki Kütüphane den birini seçtiniz mi?
 

Ekli dosyalar

  • Image 2020-06-16.jpeg
    Image 2020-06-16.jpeg
    180.5 KB · Görüntüleme: 14
tamer42' Alıntı:
Haluk Hocam merhaba,

Ben de ekli resimde olduğu veriler sütunlarda kayık geldi.
Genişletmek için tıkla ...

Ben başlıkları dikkate almamıştım..... gerekli düzenleme yapılabilir.

"Acrobat" referansını kullanmaya da gerek yok, zaten @Zeki Gürsoy dostum "Acrobat" referansına mahkum kalmayalım diye ilgili DLL'leri ve Class Modülünü hazırlamıştı.

.
 
Haluk' Alıntı:
Ben başlıkları dikkate almamıştım..... gerekli düzenleme yapılabilir.

"Acrobat" referansını kullanmaya da gerek yok, zaten @Zeki Gürsoy dostum "Acrobat" referansına mahkum kalmayalım diye ilgili DLL'leri ve Class Modülünü hazırlamıştı.

.
Genişletmek için tıkla ...
DLL'ler dosyanın bulunduğu klasörde "PdfToText" klasöründe duruyor.
bir de import edilecek dosyayı masaüstü\pdf klasörüne koydum.
acaba orada bir hata mı var?
 
Ektekilerin hepsi aynı yerde olacak...

.
 

Ekli dosyalar

  • pdf.rar
    pdf.rar
    548.7 KB · Görüntüleme: 17
Teşekkürler.
Çalışmaya başladı lakin anladığım kadarıyla bir sözcük öbeğini bulup sonrasını kaydediyor.

225229225230

bazı hücrelerde kayma oldu sanırım. alamadı veriyi.
metinlerde nasıl index yaratabiliriz?
 

Ekli dosyalar

"Düzenli ifadeler (Regular Expressions | #Regex) Nedir? Nasıl Kullanılır? #JavaScript ile Regex"
gibi şeyler izledim.
ama bir türlü bu "arrpattern"'leri modifiye edemedim.

sanırım bu "(.+)" devamını ekle anlamına geliyor.225235
 
Tetkik, endikasyonlar, bulgu, sonuç .... hepsini ekledim.

.
 

Ekli dosyalar

  • pdf.rar
    pdf.rar
    542.9 KB · Görüntüleme: 21
Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst