sadeleştirilip sıra no eklenmiş kod

Option Compare Text

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

Set Syf = Sheets("sayfa1")

Syf.Range("B2").CopyFromRecordset ADO_RS

SonStr = Syf.Cells(Syf.Rows.Count, "B").End(xlUp).Row - 1

    With Syf.Range("a2")

        .Value = 1

        .AutoFill .Resize(SonStr, 1), xlFillSeries

    End With

son:

ADO_RS.Close

ADO_CN.Close

Set ADO_RS = Nothing

Set ADO_CN = Nothing



End Sub

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

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 [Plaka] as Plk,[TOPLAM TUTAR] as Tplm " & _

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

    

    Set db = Nothing

    Set conn = Nothing



End Function