Soru ADO ile Veri Çekmek.!!

[sinan05]

Hayırlı Günler Sayın Hocalarım,
Aşağıya eklemiş olduğum makro ile kapalı dosyalardan veri çekiyorum. Fakat veriler çoğaldığı için bekleme süresi çok uzadı.Sitede araştırdığım bazı örnekleri inceledim ama yapamadım. Acaba bu işlemi ADO yöntemi ile yapabilirmiyiz? Yardımlarınız için teşekkürler.

Sub Dosyalardan_Veri_Getir()
Application.ScreenUpdating = False
Dim tarih1 As Date, tarih2 As Date, xtarih As Date
Dim evn As Object, klasoradi As String, kitap As Workbook
Dim i As Integer, x As Integer, Dosyam As Workbook
Set kitap = ThisWorkbook
Set S1 = kitap.Sheets("ANA SAYFA")
S1.Range("a3:I65536").ClearContents
tarih1 = kitap.Sheets("ANA SAYFA").Range("h1").Value
tarih2 = kitap.Sheets("ANA SAYFA").Range("j1").Value
klasoradi = "ARAÇ KAYITLARI"
Set evn = CreateObject("scripting.filesystemobject")
Set dosyalar = evn.getfolder(ThisWorkbook.Path & Application.PathSeparator & klasoradi)
For Each klasor In dosyalar.Files
    Set Dosyam = GetObject(klasor.Path)
    For i = 1 To Dosyam.Sheets.Count
       Son = S1.Range("A" & Rows.Count).End(3).Row + 1
         If Dosyam.Sheets(i).Cells(2, "K").Value = "SATILDI" Then
              xtarih = Dosyam.Sheets(i).Cells(2, "G").Value
            If xtarih >= tarih1 And xtarih <= tarih2 Then
              S1.Cells(Son, 1).Resize(, 9).Value = Dosyam.Sheets(i).Cells(2, 3).Resize(, 9).Value
            End If
         End If
       Next i
    Dosyam.Close False
 Next klasor
Set evn = Nothing: Set kitap = Nothing: Set Dosyam = Nothing
Application.ScreenUpdating = True
Range("A3").Select
End Sub

 

[Necdet]

Merhaba,

ADO yöntemi ile çözümler forumda baya var, arama yapınız.

 

[sinan05]

Merhaba,

ADO yöntemi ile çözümler forumda baya var, arama yapınız.

Necdet Hocam konuları inceledim ama benim kodlara uyarlayamadım malesef .