Bir klasördeki 50 access dosyasını Excel makro vba ile excel dosyasına dönüştürmek..

[c_235]

Arkadaşlar iyi akşamlar,bir klasördeki 50 access dosyasını içerisindeki 1 tabloyu her bir access dosyasından filtre yapmadan alıp excel dosyasına dönüştürecek bir program arıyorum...

Şöyle bir şey düşünüyorum; öncelikle tüm dosyanın adres bilgisini açmış olduğum bir excel sayfasındaki hücrelere yazacak kodu aşağıda yazdım , daha sonra ado bağlantılarıyla açılan her access dosyalarından ilgili tabloyu excel dosyasına dönüştürmek...


1.Bir klasörde excel dosyaların adreslerini yazan kod ;

' Open the file dialog
With Application.FileDialog(msoFileDialogOpen)
.AllowMultiSelect = True
.Show

' Display paths of each file selected
For lngCount = 1 To .SelectedItems.Count
Cells(lngCount, 1) = .SelectedItems(lngCount)
Next lngCount

End With

Ado bağlantıları ;

Dim con As Object, rs As Object
Dim dosya As String, sorgu As String
Dim i As Integer, a As Integer

Set con = CreateObject("ADODB.Connection")

Set rs = CreateObject("ADODB.RecordSet")
dosya = ThisWorkbook.Path & "\Burasını nasıl tanımlayacağız.mdb"
sorgu = "SELECT * FROM [Element Forces - Frames] where Frame = 'S402'"
con.Open ("Provider=Microsoft.ACE.OLEDB.12.0;" & "Data Source=" & dosya & ";")
rs.Open sorgu, con, 1, 1

On Error Resume Next

Cells.ClearContents

For i = 0 To rs.Fields.Count
Cells(1, i + 1) = rs.Fields(i).Name
Next i



Yukarıdaki ado bağlantı kodunda sadece bir access dosyasındaki verilerini filtreleyip excel dosyasın aktarmaktadır..Kısacası anlatmak istediğim bir klasörümün içinde 50 ya da daha fazla access dosyası var bunların içerisindeki 1 tabloyu filtreleme yapmadan ayrı ayrı(access dosyasıyla aynı isimle) excel dosyasına kaydetmek istiyorum. İlgilenecek arkadaşlara şimdiden teşekkür ederim..

 

[programer]

Aşağıdaki kodu bi denermisiniz

Dim evn As Object
Dim con As Object, rs As Object
Dim dosya As String, sorgu As String
Dim i As Integer, a As Integer

Set con = CreateObject("ADODB.Connection")
Set rs = CreateObject("ADODB.RecordSet")

Set evn = CreateObject("scripting.filesystemobject")
Set klasor = evn.getfolder("C:\Documents and Settings\Administrator\Desktop\deneme") 'Klsör yolunu istediğiniz gibi yazabilirsiniz
For Each dosyalar In klasor.Files
If VBA.Right(dosyalar.Name, 3) = "mdb" Then

dosya = ThisWorkbook.Path & "\" & Replace(dosyalar.Name, ".mdb", "")
sorgu = "SELECT * FROM [Element Forces - Frames] where Frame = 'S402'"
con.Open ("Provider=Microsoft.ACE.OLEDB.12.0;" & "Data Source=" & dosya & ";")
rs.Open sorgu, con, 1, 1

On Error Resume Next

Cells.ClearContents

For i = 0 To rs.Fields.Count
Cells(1, i + 1) = rs.Fields(i).Name
Next i


End If
Next

 

[c_235]

Teşekkürler bu kod çok işime yaradı. İyi çalışmalar