Tüm dosyaları tek dosyada toplamak

X

xlsx

Misafir
Arkadaşlar Selam
Kendime bir ana dosya oluşturdum desktop'da ANADOSYA isimli bir xls dosyası.Ve bilgisayarımın C diskinde Desktop'da var olan TEST isimli dosyadaki 500'e yakın farklı farklı isimdeki dosyalardan verileri bu ana dosyamın sheet1'ine alt alta aldırıyorum.Bunu kodlarla yapmak istediğimde aşağıdaki kodlar üzerinde değişiklikler yaparak bir yere kadar gelebildim.Bundan sonrası için yardımınızı rica ederim.
İstediğim şu:Bu 500 dosyayı hiç açmadan aşağıdaki kodlarda var olan dosya ismini(ABC.xls örneğin) ANADOSYA dosyamdaki G1den aşağıya doğru dosya isimlerini yazsam kodu çalıştırdığımda G1deki dosya adını okuyup ANADOSYAda altalta getirebilir mi?
G sütununa tüm dosya isimlerini de aslında altalta manuel yazdırmak da zaman kaybettirecek ama aklıma şuanda başka bir yöntem gelmedi.
Yardımınızı rica ederim.

Kod: 
[SIZE=2]
Sub aktar()
With ActiveSheet.QueryTables.Add(Connection:=Array( _
"OLEDB;Provider=Microsoft.Jet.OLEDB.4.0;Password="""";User ID=Admin;Data Source=C:\Desktop\TEST\ABC.xls;Mode=Share Deny " _
, _
"Write;Extended Properties=""HDR=YES;"";Jet OLEDB:System database="""";Jet OLEDB:Registry Path="""";Jet OLEDB:Database Password="""";Jet " _
, _
"OLEDB:Engine Type=35;Jet OLEDB:Database Locking Mode=0;Jet OLEDB:Global Partial Bulk Ops=2;Jet OLEDB:Global Bulk Transactions=1;" _
, _
"Jet OLEDB:New Database Password="""";Jet OLEDB:Create System Database=False;Jet OLEDB:Encrypt Database=False;Jet OLEDB:Don't Copy " _
, _
"Locale on Compact=False;Jet OLEDB:Compact Without Replica Repair=False;Jet OLEDB:SFP=False" _
), Destination:=Range("A1"))
.CommandType = xlCmdTable
.CommandText = Array("ABC$")
.Name = "ABC_1"
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.BackgroundQuery = True
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.PreserveColumnInfo = True
.SourceDataFile = "C:\Desktop\TEST\ABC.xls"
.Refresh BackgroundQuery:=False
End With
End Sub
[/SIZE]
 
O

omerceri

Katılım
6 Şubat 2005
Mesajlar
1,467
Örnek Ekte, verileri 3 sütun olarak yaptım, kendinize göre uyarlayın.
Not Verileri önce "Gecici" Sayfasına alıyor, "AnaDB" ye aktarıyor ve "Gecici" den siliyor.
 

Ekli dosyalar

Son düzenleme:
X

xlsx

Misafir
tşk

Kendi dosyalarıma göre ayarladıktan sonra işlemi gerçekleştirdim.Ayrıca sitedeki diğer kodları da inceledim bu konuyla ilgili çok fazla sayıda konu açılmış.Sanırım birçok kişinin işine yarayacaktır.Tşk:)
 
O

omerceri

Katılım
6 Şubat 2005
Mesajlar
1,467
Zannetmiyorum. Geçicideki bilgiler silindiğinden, Hep A1 hücresinde oluşuyor Veriler.
 
X

xlsx

Misafir
geçici dosyasında kod sonunda Veri AL özelliğinin f1 f2 f3 gibi tanımlamaları kalıyor.Kod sonunda bu dosyaya baktığınızda bu tanımlamalar silinmemiş olarak duruyor ve hangi sütuna geldiğine baktığımda IV sütununda olduğunu görüyorum
 
X

xlsx

Misafir
silme işlemi için A:E aralığını A:IV olarak yazarsak sorun çözülecek gibi geldi.E sütununun dışında diğer sütunlarda da veri varsa bunları silmediği için sorun yaratıyor olabilir diye düşündüm.Kontrol ediyorum.
 
X

xlsx

Misafir
Evet denedim biraz daha fazla dosyanın verisinin alınması mümkün oldu.(Benim dosyalarımda E sütununun yanındaki diğer sütunlarda da veriler olduğu ve bunları almak istemediğim için sadece A:E aralığını belirtmiştim.
Şimdi tek sorun f1 f2 f3 gibi dış veri al'ın özelliği olan başlıkları kaldırmada.Bu konuda yardımcı olabilir misiniz.gecici dosyasına bu veriler hiç gelmesin istiyorum.Kodlarımda nasıl bir değişiklik yapmam gerekecek.
 
X

xlsx

Misafir
xlsx' Alıntı:
Evet denedim biraz daha fazla dosyanın verisinin alınması mümkün oldu.(Benim dosyalarımda E sütununun yanındaki diğer sütunlarda da veriler olduğu ve bunları almak istemediğim için sadece A:E aralığını belirtmiştim.
Şimdi tek sorun f1 f2 f3 gibi dış veri al'ın özelliği olan başlıkları kaldırmada.Bu konuda yardımcı olabilir misiniz.gecici dosyasına bu veriler hiç gelmesin istiyorum.Kodlarımda nasıl bir değişiklik yapmam gerekecek.
Genişletmek için tıkla ...

başlıkları almamasını da kodlarda değişiklik ile yaptım.Şimdi bu şekilde fazla sayıda dosyada çalıştırmayı deneyeceğim.
 
X

xlsx

Misafir
arkadaşlar olmadı.
sanırım excel'de sınır 64 olması gerekiyor.Dış veri alırken 64 adetten fazlasını aldıramıyorum:(
 
O

omerceri

Katılım
6 Şubat 2005
Mesajlar
1,467
Sn xlsx daha önce eklediğim, dosyanın kodlarını aşağıdaki kodlarla değiştirirsen, ben 650 dosya ile test ettim sorun olmadı.
Not: Şimdi ismini hatırlamadığım bir arkadaşın "ADO_Write_Read_Delete_Update_XL.zip" adlı dosyasından yararlanarak yazdım.

Sub al()
Dim fs, f, f1, fc, s
Set fs = CreateObject("Scripting.FileSystemObject")
Set f = fs.GetFolder(ThisWorkbook.Path & "/veriler")
Set fc = f.Files
For Each f1 In fc
ad = f1.Name
say0 = Range("a1").CurrentRegion.Rows.Count + 1
DBpath = ThisWorkbook.Path & "/veriler/" & ad
ShName = "[DB]"
Rngs = "(No, Tarih, Tutar)"
Dim MyDB As DAO.Database
Dim RS As DAO.Recordset
Dim RScount As Long

Set MyDB = OpenDatabase(DBpath, False, False, "Excel 8.0")
Set RS = MyDB.OpenRecordset("select * from [DB$]")
say = say0
While Not RS.EOF
Range("A" & say).Value = RS(0)
Range("B" & say).Value = RS(1)
Range("C" & say).Value = RS(2)
say = say + 1
RS.MoveNext
Wend
RS.Close
MyDB.Close
Set RS = Nothing
Set MyDB = Nothing


Next
End Sub
Not:VBA sayfasında iken, Tools/References'e tıklayın. Çıkan listede "Microsoft DAO 3.6 Object Library" işaretleyin.
 
Son düzenleme:
X

xlsx

Misafir
bu şekliyle de deneyeceğim, şu aşamaya kadar olan dosya da işime yaradı işin aslı.Ama bu son halini kendi dosyalarıma göre hemen değiştirip denemek istiyorum.Tşk ilginiz için
 
O

omerceri

Katılım
6 Şubat 2005
Mesajlar
1,467
Kusura bakmayın belirtmeyi unutmuşum.
VBA sayfasında iken, Tools/References'e tıklayın. Çıkan listede "Microsoft DAO 3.6 Object Library" işaretleyin.
 
X

xlsx

Misafir
başarılı

Tşk omerceri, sayenizde yeni birşey öğrenmiş oldum.Dediğiniz gibi bu şekilde dosya sınırı olmadan yapılabiliyor.
 
X

xlsx

Misafir
Son olarak A B ya da C sütununda alt alta text varsa ok sorun yok .Ama bu sütunlarda hem text hem de sayısal bir veri olunca run time error 1004 Sayısal alan taşması veriyor.
No​
​
​
Tarih​
​
​
Tutar​
​
​
1​
​
​
DENEME​
​
​
1000​
​
​
2​
​
​
TEST​
​
​
4343​
​
​
a​
​
​
3​
​
​
c​
​
​

şeklinde örneğin yerleştirince.

Range("A" & say).Value = RS(0) satırında Value bölümünde nasıl bir değişiklik yapmam gerekir.
 
Cevap yazmak için giriş yap yada kayıt ol.
Üst