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
Altın Üyelik Bitiş Tarihi
10-06-2024
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

O

onder_09

Altın Üye
Katılım
17 Mart 2017
Mesajlar
206
Excel Vers. ve Dili
2016 türkçe
Altın Üyelik Bitiş Tarihi
19-07-2025
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
 
Erdem Akdemir

Erdem Akdemir

Destek Ekibi
Destek Ekibi
Katılım
4 Mayıs 2007
Mesajlar
3,636
Excel Vers. ve Dili
2016 PRO TÜRKÇE-İNG. 64 BİT
Kişisel bilgileri uluorta koymanız doğru değil.
 
H

Haluk

Özel Üye
Katılım
7 Temmuz 2004
Mesajlar
12,406
Excel Vers. ve Dili
64 Bit 2010 - İngilizce
+
Google Sheets
+
JScript
Altın Üyelik Bitiş Tarihi
∞
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.

.
 
seckinb

seckinb

Katılım
9 Aralık 2018
Mesajlar
363
Excel Vers. ve Dili
Excel 2019 - 32 bit TR
Altın Üyelik Bitiş Tarihi
10-06-2024
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.
 
seckinb

seckinb

Katılım
9 Aralık 2018
Mesajlar
363
Excel Vers. ve Dili
Excel 2019 - 32 bit TR
Altın Üyelik Bitiş Tarihi
10-06-2024
Uyarınızı dikkate aldım.
Uğraştığım dosyayı eklentilerini ulaştırıyorum.
 

Ekli dosyalar

seckinb

seckinb

Katılım
9 Aralık 2018
Mesajlar
363
Excel Vers. ve Dili
Excel 2019 - 32 bit TR
Altın Üyelik Bitiş Tarihi
10-06-2024
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
 
H

Haluk

Özel Üye
Katılım
7 Temmuz 2004
Mesajlar
12,406
Excel Vers. ve Dili
64 Bit 2010 - İngilizce
+
Google Sheets
+
JScript
Altın Üyelik Bitiş Tarihi
∞
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

.
 
seckinb

seckinb

Katılım
9 Aralık 2018
Mesajlar
363
Excel Vers. ve Dili
Excel 2019 - 32 bit TR
Altın Üyelik Bitiş Tarihi
10-06-2024
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
 
H

Haluk

Özel Üye
Katılım
7 Temmuz 2004
Mesajlar
12,406
Excel Vers. ve Dili
64 Bit 2010 - İngilizce
+
Google Sheets
+
JScript
Altın Üyelik Bitiş Tarihi
∞
Verilen örnek PDF üzerinde çalıştı....

.
 
H

Haluk

Özel Üye
Katılım
7 Temmuz 2004
Mesajlar
12,406
Excel Vers. ve Dili
64 Bit 2010 - İngilizce
+
Google Sheets
+
JScript
Altın Üyelik Bitiş Tarihi
∞
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ı.

.
 
seckinb

seckinb

Katılım
9 Aralık 2018
Mesajlar
363
Excel Vers. ve Dili
Excel 2019 - 32 bit TR
Altın Üyelik Bitiş Tarihi
10-06-2024
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?
 
H

Haluk

Özel Üye
Katılım
7 Temmuz 2004
Mesajlar
12,406
Excel Vers. ve Dili
64 Bit 2010 - İngilizce
+
Google Sheets
+
JScript
Altın Üyelik Bitiş Tarihi
∞
Ektekilerin hepsi aynı yerde olacak...

.
 

Ekli dosyalar

  • pdf.rar
    548.7 KB Görüntüleme: 16
seckinb

seckinb

Katılım
9 Aralık 2018
Mesajlar
363
Excel Vers. ve Dili
Excel 2019 - 32 bit TR
Altın Üyelik Bitiş Tarihi
10-06-2024
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

seckinb

seckinb

Katılım
9 Aralık 2018
Mesajlar
363
Excel Vers. ve Dili
Excel 2019 - 32 bit TR
Altın Üyelik Bitiş Tarihi
10-06-2024
"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
 
H

Haluk

Özel Üye
Katılım
7 Temmuz 2004
Mesajlar
12,406
Excel Vers. ve Dili
64 Bit 2010 - İngilizce
+
Google Sheets
+
JScript
Altın Üyelik Bitiş Tarihi
∞
Tetkik, endikasyonlar, bulgu, sonuç .... hepsini ekledim.

.
 

Ekli dosyalar

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