Aşağıda vermiş olduğum makroda değişik renkli olarak işaretlediğim satırda ki ifadede çalışma durmakta
tamemen kaldırdığımda ise makro gereğini yaptığı halde bulduğu neticeleri Sonuç sahifesine yazmamaktadır.Bu konuda 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("A" & 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
Visual Basic makro hatası
OP Taze Üye
Teşekkür Sayısı: 0
2 mesaj
Kayıt Tarihi:Kayıt: Şub 2012