Çalıştıramadığım Kod

[meltun]

Sub rapor_Jokeyler()
Dim con As Object, rs As Object, sorgu As String, evn As Object, yol As String
Dim klasor As Object, dosya As Object, tStart As Double, tEnd As Double
Dim DataCount As Long, RecCount As Long, son As Long, DIGIDIK As Long
yol = "D:\JOKEYLER"
tStart = Timer
Set con = CreateObject("adodb.connection")
Set rs = CreateObject("adodb.recordset")
Set evn = CreateObject("scripting.filesystemobject")
Range("A2:AK65536").ClearContents
Set klasor = evn.getfolder(yol)
With Sheets("SONUÇ")
For Each dosya In klasor.Files
If LCase(Right(dosya.Name, 3)) = "xls" Then
DIGIDIK = DIGIDIK + 1
con.Open "provider=Microsoft.ACE.OLEDB.12.0;data source=" & dosya.Path & ";extended properties=""excel 12.0;hdr=yes"""
rs.Open "SELECT Jokeyler FROM [Veritabani$]", con, 1, 1
DataCount = DataCount + rs.RecordCount
son = Sheets("liste").Range("a65536").End(3).Row
rs.Close
For i = 1 To son

sorgu = "SELECT * FROM [Veritabani$] WHERE Jokeyler = '" & Sheets("liste").Cells(i, 1).Text & "' AND PİST = '" & Sheets("liste").Cells(i, 2).Text & "'"
rs.Open sorgu, con, 1, 1
RecCount = RecCount + rs.RecordCount
.Range("a65536").End(3)(2, 1).CopyFromRecordset .Row
rs.Close
Next i
con.Close
End If
Next
tEnd = Timer
End With
MsgBox "İşlem tamam..." & vbCrLf & vbCrLf _
& "Toplam " & DIGIDIK & " adet dosyada " & FormatNumber(DataCount, 0) & " adet 'SATIR BİLGİ' taranarak, " _
& RecCount & " adet VERİ " & vbCrLf _
& Format((tEnd - tStart), "#0.00") & " saniye içinde bulundu.", vbInformation, "VERİ..."
Range("A2").Select
Set rs = Nothing: Set con = Nothing
j = Empty: DataCount = Empty: RecCount = Empty
Set evn = Nothing: Set klasor = Nothing: Set dosya = Nothing
sorgu = vbNullString: son = Empty: tStart = Empty: tEnd = Empty
End Sub


İşaretli olan satırda ilerleme yapmamaktadır. Çözümü hususunda gereğini rica ederim.Saygılarımla

[meltun]

Sorun çözülmüştür. Hatanın kaynağı söz dizimi esnasında fazla bırakılan aralıktır. Teşekkür ederim.