error'1044' aplication defined hatası

[MELTUN]

Run-time error'1044' aplication defined or object-defined errorYukarıdaki mesajı aşağıda ki makro çalıştığın ve işaretli satıra geldiğinde alıyorum.Yardımlarınızı rica ediyorum Saygılarımla
Private Sub CommandButton1_Click()
Dim DB As Object
Dim RS As Object
Dim dbRow As Long
Dim KapDosya As Variant
Dim i As Long, NoA1 As Long, NoA2 As Long
Dim MyPath As String
Dim j As Integer, DataCount As Long, RecCount As Long
Dim tStart As Double, tEnd As Double

tStart = Timer
MyPath = "C:\Sonuclar"

If Dir(MyPath, vbDirectory) = Empty Then
MsgBox MyPath & " dizini bulunamadı, kontrol edin...!", vbCritical, "Dikkat !"
Exit Sub
End If

On Error Resume Next
Set daoDBEngine = CreateObject("DAO.DBEngine")
Set daoDBEngine = CreateObject("DAO.DBEngine.36")
On Error GoTo 0

MyFile = Dir(MyPath & "\*.xls", vbDirectory)
NoA2 = Sheets("Sonuc").Cells(65536, 1).End(xlUp).Row + 1
Sheets("Sonuc").Range("A2:L" & NoA2).Clear

Do While MyFile <> ""
If MyFile = ThisWorkbook.Name Then GoTo ResumeSub:
j = j + 1
NoA1 = Sheets("Liste").Cells(65536, 1).End(xlUp).Row + 1
KapDosya = MyPath & "\" & MyFile
Set DB = daoDBEngine.OpenDatabase(KapDosya, False, False, "Excel 8.0; HDR=Yes; IMEX=1;")
NoA2 = Sheets("Sonuc").Cells(65536, 1).End(xlUp).Row + 1

Set RS = DB.OpenRecordset("select ` ADI` from [VeriTabanı$]")
RS.MoveFirst
RS.MoveLast
DataCount = DataCount + RS.RecordCount
RS.Close

For i = 1 To NoA1 - 1
Set RS = DB.OpenRecordset("select * from [VeriTabanı$] where ` ADI` = '" & Sheets("Liste").Cells(i, 1).Text & "' and `CİNS` = '" & Sheets("Liste").Cells(i, 2).Text & "'")
NoA2 = Sheets("Sonuc").Cells(65536, 1).End(xlUp).Row + 1
If RS.RecordCount > 1 Then
RS.MoveFirst
RS.MoveLast
End If
Sheets("Sonuc").Range("A2& NoA2").CopyFromRecordset RS
RecCount = RecCount + RS.RecordCount
RS.Close
Next

ResumeSub:
MyFile = Dir
DB.Close
Loop

tEnd = Timer

MsgBox "İşlem tamam..." & vbCrLf & vbCrLf _
& "Toplam " & j & " adet dosyada " & Format(DataCount, "#,###") & " adet veri taranarak, " _
& RecCount & " adet sonuç " & vbCrLf _
& Format((tEnd - tStart), "#0.00") & " saniye içinde bulundu.", vbInformation, "Sonuç..."

Set RS = Nothing
Set DB = Nothing
Set daoDBEngine = Nothing
End Sub

 

[mancubus]

Sheets("Sonuc").Range[COLOR="Red"]("A" & NoA2[/COLOR]).CopyFromRecordset RS

 

[MELTUN]

Sn;Mancubus
İlginiz ve yardımlarınız için teşekkür ederim.
Mesaj içeriğinizdeki kodu aynen yazdığımda bu defa hata kodu:Run-time'-2147467259(80004005)'Method'CopyFromRecordset'of object 'Range' failed olarak değişti.Bilgilerinizi rica eder,yardımlarınızın devamını dilerim.Saygılarımla

 

[mancubus]

rica ederim. ama DAO'ya hakim değilim. sadece hata veren yere bakmıştım.

 

[MELTUN]

Sn;Mancubus
İlginiz benim için yeterli tekrar teşekkür ederim.Saygılarımla

 

[mancubus]

daha önce kullanılmış bir dosya mıdır bilmiyorum ama sorgunun sonunda çift tırnak eksik sanki.

"select * from [VeriTabanı$] where `ADI` = '" & Sheets("Liste").Cells(i, 1).Text & "' and `CİNS` = '" & Sheets("Liste").Cells(i, 2).Text & "'""")

ana dosyadaki bir değere uyan belli bir klösördeki tüm dosyların ilgili sayfasındaki satırların kopyalanması gibi bir ihtiyaç söz konusu ise farklı yöntemler de bulunabilir.

 

[MELTUN]

Sn;Mancubus
Kısaca;C deki sonuçlar klasörünün içerisinde bulunan kapalı dosyada ki veriler arasından LİSTE sahifesinde A sütünunda ADI ,B sütününda CİNS' i yazılı olanları seçerek,alıyor ve Sonuc sahifesine kopyalıyor.Yeni işlemde eskileri siliyor,yeniye ait bilgilere ayni işlemi yaparak devam ediyor.
En son verdiğiniz bilgilendirme gereğini yaptığımda bu defa Run-time error'3075': ADI='Kenan' and ' CİNS= Erk."" sorgu ifadesi içindeki dizede söz dizimi hatası na dönüştü Bilgilerinizi rica ederim.Saygılarımla

 

[mancubus]

test etmeden ekleyince böyle oldu. son 2 tırnağı silin. yani eski haline gelsin.

dosyaları görmeden konuşmak zor...

anladığım kadarı ile çalışan dosya. belki kritere uyan veri ile ilgili problem vardır.
dediğim gibi, çok hakim değilim, yanlış yönlendirmeyeyim.

şurada kapalı dosya veri alma uygulamaları var. belki biri yardımcı olur:
http://www.excel.web.tr/f117/