Klasör içindeki pdf dosyalarından excele veri almak

[halit3]

İyi akşamlar

 

[halit3]

Kod veri alırken 64 bit ile 32 bit arasında farklılıklar oluyor.
yazılmış olan kod 64 bit bilgisayarda veri alıyor eğer 32 bit bilgisayarda veri alınacaksa kodları revize etmek gerekebilir.

 

[halit3]

Bu dosyada A sutünundaki veri 32 bit bilgisayarla ile alınmıştır B sutunundaki veri ise 64 bit bilgisayarla alınmıştır.

 

[tahsinanarat]

Sn. Halit hocam 2500 pdf dosyada uyguladım, sonuç mükemmel 50 sn. De işlem tamam. Tekrar çok teşekkürler.

 

[halit3]

Sonuç iyi olunca her şey güzel iyi çalışmalar

 

[tahsinanarat]

Halit hocam bu konuyu evvelce işlemiştik, sigorta giriş bildirgeleri bazen ekli SGK giriş formatında gelmekte olup, bu tip bildirgeler için ayrıca başka bir excel dosyasına almak istiyorum. 19.Mesajda verdiğiniz gibi tek tek numaralarını aldım ancak önceden aldığımız gibi bütün bilgilere ulaşamadım.
Tespit ettiğim numaralar;
sayf2 = "veri"
sat = Worksheets(sayf2).Cells(Rows.Count, 1).End(3).Row + 1
ReDim deg(16)
deg(1) = ssd(14)
deg(2) = ssd(19)
deg(3) = ssd(20)
deg(4) = ssd(21)
deg(5) = ssd(22)
deg(6) = ssd(23)
deg(7) = ssd(24)
deg(8) = ssd(25)
deg(9) = ssd(43)
deg(10) = ssd(50)

ancak bilgiler ;
6 Doğum Yer İSTANBUL Ale Sıra No(Hane/Kütük) 0000019
şeklinde geliyor, örnek olarak gönderdiğim pdf dosyasına göre kodları düzenleyebilirmisiniz.
Teşekkürler.

 

[halit3]

Bu kodu bir dene

Private pdfDoc As PDFDocument, pages As PDFPageCollection

Sub CommandButton2_Click()

Liste (ThisWorkbook.Path)
MsgBox "İşlem tamam"
End Sub


Private Sub Liste(yol As String)
Dim fL As Object, f As Object
Set fL = CreateObject("Scripting.FileSystemObject")

'On Error Resume Next
For Each dosya In fL.GetFolder(yol).Files
dosya_adi = fL.GetBaseName(dosya) ' klasörün kendisi
If LCase(fL.GetExtensionName(dosya)) = "pdf" Then ' uzantı buluyor
ReDim ssd(5000)

Set pdfDoc = New PDFDocument
Set pages = pdfDoc.OpenPdf(dosya) 'Parola olmadığı varsayıldı.
say = 1

'Worksheets("data").Cells.ClearContents

For t = 0 To pages.Count - 1

degg = pages(t).GetText
For k1 = 1 To 20
degg = Replace(degg, " ", "^")
Next k1

For k2 = 1 To 20
degg = Replace(degg, "^^", "^")
Next k2

For k3 = 1 To 20
degg = Replace(degg, "^", " ")
Next k3


deg55 = Split(degg, Chr(10))
If UBound(deg55) > 0 Then
For k4 = 0 To UBound(deg55) - 1
If Len(Trim(deg55(k4))) > 1 Then

ssd(say) = Trim(deg55(k4))
'Worksheets("data").Cells(say, 1).Value = Trim(deg55(k4))
say = say + 1
End If
Next k4
End If
say = say + 1
Next t

sayf2 = "veri"

sat = Worksheets(sayf2).Cells(Rows.Count, 1).End(3).Row + 1

ReDim deg(16)
deg(1) = ssd(11)
deg(2) = ssd(15)
deg(3) = ssd(16)
deg(4) = ssd(18)
deg(5) = ssd(19)
deg(6) = ssd(20)
deg(7) = ssd(21)
deg(8) = ssd(16)
deg(9) = ssd(17)
deg(10) = ssd(18)
deg(11) = ssd(19)
deg(12) = ssd(20)
deg(13) = ssd(21)
deg(14) = ssd(42)
deg(15) = ssd(43)
deg(16) = ssd(37)


For i = 1 To 16


'deg(i) = Replace(deg(i), " ", "")


If i = 1 Then
deg2 = Split(deg(1), "BELGENİN")
If UBound(deg2) > 0 Then
Worksheets(sayf2).Cells(sat, i).Value = Replace(deg2(0), " ", "")
End If
End If



If i = 2 Then
deg2 = Split(deg(2), " ")
If UBound(deg2) > 0 Then
Worksheets(sayf2).Cells(sat, i).Value = deg2(2)
End If
End If

If i = 3 Then
deg2 = Split(deg(3), " ")
If UBound(deg2) > 0 Then
Worksheets(sayf2).Cells(sat, i).Value = deg2(2)
End If
End If

If i = 4 Then
deg2 = Split(deg(4), " ")
If UBound(deg2) > 0 Then
Worksheets(sayf2).Cells(sat, i).Value = deg2(3)
End If
End If

If i = 5 Then
deg2 = Split(deg(5), " ")
If UBound(deg2) > 0 Then
Worksheets(sayf2).Cells(sat, i).Value = deg2(3)
End If
End If

If i = 6 Then
deg2 = Split(deg(6), " ")
If UBound(deg2) > 0 Then
Worksheets(sayf2).Cells(sat, i).Value = deg2(3)
End If
End If

If i = 7 Then
deg2 = Split(deg(7), " ")
If UBound(deg2) > 0 Then
Worksheets(sayf2).Cells(sat, i).Value = deg2(3)
End If
End If

If i = 8 Then
deg2 = Split(deg(8), "İl ")
If UBound(deg2) > 0 Then
Worksheets(sayf2).Cells(sat, i).Value = deg2(1)
End If
End If

If i = 9 Then
deg2 = Split(deg(9), "İlçe ")
If UBound(deg2) > 0 Then
Worksheets(sayf2).Cells(sat, i).Value = deg2(1)
End If

End If

If i = 10 Then
deg2 = Split(deg(10), "Mahalle/Köy")
If UBound(deg2) > 0 Then
Worksheets(sayf2).Cells(sat, i).Value = deg2(1)
End If
End If

If i = 11 Then
deg2 = Split(deg(11), " Clt No ")
If UBound(deg2) > 0 Then
Worksheets(sayf2).Cells(sat, i).Value = deg2(1)
End If
End If

If i = 12 Then
deg2 = Split(deg(12), "(Hane/Kütük) ")
If UBound(deg2) > 0 Then
Worksheets(sayf2).Cells(sat, i).Value = deg2(1)
End If
End If

If i = 13 Then
deg2 = Split(deg(13), " (Brey)Sıra No ")
If UBound(deg2) > 0 Then
Worksheets(sayf2).Cells(sat, i).Value = deg2(1)
End If
End If


If i = 14 Then
deg2 = Split(deg(14), "başladığı tarh ")
If UBound(deg2) > 0 Then
Worksheets(sayf2).Cells(sat, i).Value = deg2(1)
End If
End If

If i = 15 Then
deg2 = Split(deg(15), "17 Meslek Adı ve Kodu")
If UBound(deg2) > 0 Then
Worksheets(sayf2).Cells(sat, i).Value = deg2(1)
End If
End If


If i = 16 Then
deg2 = Split(deg(16), "Scl Numarası ")
If UBound(deg2) > 0 Then
Worksheets(sayf2).Cells(sat, i).Value = deg2(1)
End If
End If

Next i

End If
Next
Set fL = Nothing

End Sub

 

[tahsinanarat]

Halit hocam çok teşekkür ederim, her iki koddan da çıktı alıp karşılaştıracağım, o kadar uğraşmama rağmen beceremedim. Hayırlı geceler hocam.

 

[tahsinanarat]

Sn. @halit3 hocam 19 nolu mesajınıza ilaveten mesaj kutusuna veya herhangi bir sutuna alan isim ve numaralarını yazdırabilir miyiz.

 

[yugarito]

HALİT HOCAM SELAMLAR,
DOSYAYI ÇOK BEĞENDİM ELİNİZE SAĞLIK.

ANCAK BUNU EKTEKİ PDF VERİLERİNİ EXCEL'E AKTARMAK İÇİN NE YAPABİLİRİM.