çalışmanız Excel üzerinden olmayacak mı?
aşağıdaki çalışmayı inceler misiniz?
1 - tüm dosyalar aynı klasörde olmalı
2 - referanslardan Microsoft ActiveX Data Object x.x library eklenmeli
3 - 4. hakedis dosyanızda fazladan bir DTR TARİHİ sütunu vardı o sütun silindi
4 - dosyanız macro çalıştıran formata çevrildi xlsm
Verileri alma fonksiyonu

Option Compare Text' sayfanın en başına küçük/büyük harf farkı olmasın diye



Sub VeriAl()

Dim Sql As String

Dim ADO_CN As ADODB.Connection



xSQL = dosyaAdi_FSO

Set ADO_CN = New ADODB.Connection



ADO_CN.ConnectionString = "provider=Microsoft.ACE.OLEDB.12.0;data source=" & ThisWorkbook.FullName & _

                          ";extended properties=""excel 12.0 Xml;hdr=Yes"""

ADO_CN.Open



SQL = "SELECT Uni.Plk, Count(Uni.Plk) AS SayF1, Sum(Uni.Tplm) AS ToplaF6 " & _

      "FROM (" & xSQL & ") as Uni " & _

      "GROUP BY Uni.Plk;"



Set ADO_RS = ADO_CN.Execute(SQL) ' güncelleme yapabilmek için 1,3 0lmalı yada  adOpenKeyset, adLockOptimistic



'  Eğer Hiç Kayıt Yoksa

If ADO_RS.RecordCount = 0 Then

    MsgBox "Kayıt Bulunamadı.", vbCritical, "Veri Yok"

    GoTo son

End If



Sheets("sayfa1").Range("B2").CopyFromRecordset ADO_RS



son:

ADO_RS.Close

ADO_CN.Close

Set ADO_RS = Nothing

Set ADO_CN = Nothing



End Sub

klasördeki tüm Excel dosyalarını alma

Function dosyaAdi_FSO() As String

Dim FSO As Object '//FileSystemObject

Dim f As Object '//File Object

AnaKlsr = ThisWorkbook.Path & "\"

 

 Set FSO = CreateObject("Scripting.FileSystemObject")

With FSO

    If .FolderExists(AnaKlsr) Then

        For Each f In .GetFolder(AnaKlsr).Files

            If f.Name <> ThisWorkbook.Name And Left(f.Name, 1) <> "~" And f.Type Like "*excel*" Then 'Debug.Print say, f.Name, SyfAdiAl(f.Path)

                SqlDsy = SqlDsy & SyfAdiAl(f.Path)

            End If

        Next f

    End If

End With

dosyaAdi_FSO = Mid(SqlDsy, 10)

End Function

exceldeki ilk sayfayı alma ve Sql kodu oluşturma

Function SyfAdiAl(fn As String) As String 'fn tam yol + ad

    Dim conn As Object, db As Object

    Dim tbl As Object



    Set conn = CreateObject("DAO.DBEngine.120")

    Set db = conn.OpenDatabase(fn, False, True, "Excel 12.0 Xml;HDR=Yes;")

    

    Set tbl = db.TableDefs(0) ' 0 is Sheets(1) : 1 is Sheets(2)

    SyfAdiAl = CStr(Replace(tbl.Name, "'", ""))  ' sadece ilk sayfa tblAdi = CStr(Replace(tbl.Name, "'", ""))

    SyfAdiAl = "Union all " & _

              "SELECT [" & tbl.Fields(1).Name & "] as Plk,[" & tbl.Fields(5).Name & "] as Tplm " & _

              "FROM [" & SyfAdiAl & "B:F] IN """ & fn & """ ""EXCEL 12.0 xml;"" "

    

    Set db = Nothing

    Set conn = Nothing



End Function