Word'den Excele Veri Aktarımı

[muzzymania]

merhabalar sistemden dosyaları indiremedim

Bir klasörde 100 tane müşteri isimleriyle kaydedilmiş word dosyaları var , ben o word dosyalarında bulunan bazi bilgilere bakmak için tüm dosyaları açmam gerekiyor bazen , bundan kurtulmak için

bu klasördeki 100 word dosyalarını açıp içindeki tüm veriyi , yeni bir excel sayfasına yapıştırmak mümkünmüdür?

böylece bende sayfalara aktarılan bilgilerden istediklerimi ayrı bir prosedürle bulmaya çalışacağım

eğer yardım ederseniz çok sevinirim , lütfen ufkumu açın

 

[leumruk]

Merhaba,
Mesajınızı buraya taşıdım. Diğer konu hem çok eski hem de oldukça fazla mesajdan oluşuyordu.
İsteğiniz için örnek dosya eklemeniz gerekli. Verilerin excele ne şekilde aktarılmasını istediğiniz örnek bir excel dosyası ve aktarılacak word dosyalarınızdan birkaç tane eklemelisiniz.

 

[muzzymania]

teşekkür ederim leumruk;

her bir word dosyası ekteki gibi tablolar ve altında resim içeren tablolardan oluşuyor , biz sadece ilk sayfadaki 2 tabloyu kullanıyoruz diğerlerini sildim bu sebeple umarım problem olmaz.

yani her word dosyasındaki ilk iki tablo ( yada ilk sayfa) kopyalanıcak, excele yapışcak ve satır çeklinde her başlık ve veriler yazılacak ..


umarım çok zor değildir

 

[leumruk]

teşekkür ederim leumruk;
her bir word dosyası ekteki gibi tablolar ve altında resim içeren tablolardan oluşuyor , biz sadece ilk sayfadaki 2 tabloyu kullanıyoruz diğerlerini sildim bu sebeple umarım problem olmaz.
yani her word dosyasındaki ilk iki tablo ( yada ilk sayfa) kopyalanıcak, excele yapışcak ve satır çeklinde her başlık ve veriler yazılacak ..
umarım çok zor değildir

Merhaba,
Örnek dosya eklemeyi unutmuşsunuz. Word dosyalarından diğer sayfaları silmeyin. En azından 2-3 sayfa bulunsun. Deneme yaparken bu önemli.

 

[muzzymania]

ilginize ne kadar teşekkür etsem az,

doyayı eklemeye çalışıcam 3 farklı format içinde eklemeye çalışcam;

sadece sarı alanlar alınacak ilk sayfadan ve satır satır yazılacak sanıyorum böylece istediğim verilerin arşivi oluşmuş olacak sayenizde ....

 

[muzzymania]

1.format dosya ektedir

 

[muzzymania]

2.format ektedir

 

[muzzymania]

3. format ektedir

 

[leumruk]

Merhaba,
Syn. muzzymania,
İstediğiniz eylemi yapmak problem değil; ancak 100 adet word dosyasını excele almak demişsiniz ki, bu pek mantıklı bir iş olmaz. Tabloları alt alta aldığımızı varsayarsak istediğiniz veriyi bulmanız zor olacak, sayfa sayfa aktardığımızda excel 100'lerce sayfa da çok kullanışlı olmayacaktır. Bunu yerine size şunu öneriyorum. İlk mesajınızda word dosyalarını müşteri ismiyle kaydettiğinizi yazmışsınız. Bir comboboxa bu word dosyalarını listelettirelim ve siz hangi müşteriyi seçerseniz o açılsın ya da o word dosyasının ilk sayfasını excele alsın...

 

[muzzymania]

saolun sevgili leumruk, benim istediğim bilgi müşteri adından ziyade o tabloların içindeki ada ve parsel bilgileri , yaklaşık toplamda 50 000 tane dosyada bu bilgiler var ve bizden herhangi bir ada /parselde yerimiz var mı diye soruklarında 50000 veriyi açmak zorundayız bilgi almak için , malesef yanlış arşivleme yüzünden böyle bir iş yükü ile karşı karşıyayız .

:yardim::dua::kafa::frown:

 

[leumruk]

Merhaba,
Bir ön çalışma yaptım. İnceleyin, istediğiniz gibiyse bunun üzerinden devam edelim. Sistem şu şekilde çalışıyor: Butona bastığınızda excel dosyasının içinde bulunan word dosyalarını sırayla açıyor ve sarı renkle belirttiğiniz hücrelerde bulunan verileri soldan sağa sırasıyla excele aktarıyor. Tek sıkıntı, word şablonlarınızdan birinin tablo yapısı diğerleriyle uyumlu olmadığı için bu dosyanın bilgilerinden bazıları alt alta gelmiyor.
Eklediğiniz şablonların klasörleri ayrı ayrı ise bir sıkıntı olmaz. Değilse, bu tür dosyalarınızdaki bilgileri farklı bir sayfaya almasını sağlayabiliriz.
Eklediğim örnekteki klasörü rardan çıkarın ve excel dosyasını açarak butona tıklayın.

Sub Veri_Al()
Dim tbl As Table
Dim hcr As Cell
Cells.Clear
yol = ThisWorkbook.Path & "\"
dsy = Dir(yol & "*doc*")
Set wd = CreateObject("word.Application")
wd.Visible = True
Sat = 1
Do While Len(dsy) <> ""
Sat = Sat + 1
If dsy = "" Then Exit Do
wd.Application.Documents.Open yol & dsy
Sut = 3
If wd.ActiveDocument.Tables.Count < 2 Then
    Cells(Sat, 1) = Sat - 1
    Cells(Sat, 2) = dsy
    GoTo Atla
End If
For x = 1 To 2
    Set tbl = wd.ActiveDocument.Tables(x)
    For Each hcr In tbl.Range.Cells
    knt = knt + 1
    If x = 1 And knt > 8 Then: knt = 0: Exit For
    If x = 2 And knt > 36 Then: knt = 0: Exit For
    If hcr.ColumnIndex = 2 Or hcr.ColumnIndex = 4 Then
        Cells(Sat, 1) = Sat - 1
        Cells(Sat, 2) = dsy
        hcr.Range.Select
        wd.Selection.Copy
        Cells(Sat, Sut).PasteSpecial Paste:=xlValues
        Sut = Sut + 1
    End If
    Next
Next
Atla:
wd.ActiveDocument.Close False
dsy = Dir
Loop
Range("a1:x" & [a65536].End(3).Row).Borders.LineStyle = xlContinuous
End Sub

 

[muzzymania]

ne kadar teşekkür etsem az , inanın bize çok kıymetlibir hediye verdiniz zaman gibi ...

farklı formatlar dediğiniz gibi kayıyor kayan yerlerden çıkarılabilir problem olmaz,

yalnız söylemiştim çok word var bu kalsörün içindeki word sayısı problem olmaz değilmi sanki tek tek açıp kapıyor gibi ...

çok faydalı bir çalışma umarım herkes kullanır...saygılarımla , tekrar tşk ederim

 

[leumruk]

ne kadar teşekkür etsem az , inanın bize çok kıymetlibir hediye verdiniz zaman gibi ...
farklı formatlar dediğiniz gibi kayıyor kayan yerlerden çıkarılabilir problem olmaz,
yalnız söylemiştim çok word var bu kalsörün içindeki word sayısı problem olmaz değilmi sanki tek tek açıp kapıyor gibi ...
çok faydalı bir çalışma umarım herkes kullanır...saygılarımla , tekrar tşk ederim

Rica ederim.
Word dosyalarının sayısı önemli değil. Yeterki excelin satır sayısından fazla olmasın. Word dosyalarını tek tek açıp tablolardan gerekli bilgileri alıp yeniden kapatıyor. Dosya sayısına göre biraz uzun sürebilir, onun dışında bir problem olmaz.

 

[muzzymania]

çok teşekkürler ....bu forumu seviyorum