Ado ile Kapalı Dosyalardan Tarih Aralığına Göre Veri Alma Kod Yardımı

Believing

Altın Üye
Katılım
19 Mayıs 2013
Mesajlar
698
Excel Vers. ve Dili
Office Pro 2019 TR 32 Bit
Windows Pro 10 TR 64 Bit
Altın Üyelik Bitiş Tarihi
23-08-2028
Sayın Uzman Arkadaşlar,

Bir klasör içerisinde farklı isimlerdeki kapalı çalışma kitaplarından, açık olan Rapor isimli çalışma kitabına veri transferi yapılıyor. Aşağıdaki kodlar alıntı olup, veri transferi "I2" hücresindeki tarihe göre yapılmaktadır. "H2" ilk tarih "I2" son tarih olacak şekilde iki tarih aralığına göre veri transferi yapmak istiyorum. Bu koşula göre aşağıdaki kodlarda nasıl bir değişiklik yapmalıyım.

Saygılarımla,
Ömer Ali ÜZÜMCÜ

Kod:
DefObj C-D, F, R: DefStr S-T, Y: DefInt I-J
Sub Emre()
    Set con = CreateObject("adodb.connection")
    Set rs = CreateObject("adodb.recordset")
    Set fso = CreateObject("Scripting.FileSystemObject")
    Application.ScreenUpdating = False
    yol = ThisWorkbook.Path
    Range("A2:G65536").ClearContents
    al = CLng(CDate(Range("I2").Value))
    For Each dosya In fso.getfolder(yol).Files
        If dosya.Name <> ThisWorkbook.Name And _
            Mid(dosya.Name, 2, 1) <> "$" Then
            con.Open "provider=microsoft.ace.oledb.12.0;data source=" & _
            dosya & ";extended properties=""Excel 12.0; hdr=no;IMEX=1"""
            t = "select * from [Sayfa1$A15:F65536]"
            t = t & " WHERE clng(cdate([f1]))=" & al & " and not isnull([F1])"
            rs.Open t, con, 1, 1
            oo = rs.RecordCount
            If oo < 1 Then GoTo 10
            Range("A65536").End(3)(2, 1).CopyFromRecordset rs
            Range("G65536").End(3)(2, 1) = Replace(dosya.Name, ".xls", "")
            If oo > 1 Then
            g = Range("G65536").End(3).Row
            Range("G" & g & ":G" & (g + oo) - 1).FillDown
            End If
10          rs.Close
            con.Close
        End If
    Next dosya
    Application.ScreenUpdating = True
    MsgBox "İşlem Tamamlandı.", vbInformation, "Www.ExcelArsivi.Com"
    i = Empty: j = Empty: s = "": t = "": y = "": Set dosya = Nothing
    Set rs = Nothing: Set fso = Nothing: Set con = Nothing
End Sub
 

Believing

Altın Üye
Katılım
19 Mayıs 2013
Mesajlar
698
Excel Vers. ve Dili
Office Pro 2019 TR 32 Bit
Windows Pro 10 TR 64 Bit
Altın Üyelik Bitiş Tarihi
23-08-2028
Sayın Uzman Arkadaşlar,

Yukarıdaki kodu iki tarih aralığına göre nasıl revize edebilirim? Benim için çok değerli olan yardımlarınızı rica ediyorum.

Saygılarımla,
Ömer Ali ÜZÜMCÜ


Kod:
al = CLng(CDate(Range("I2").Value))
 

Erdem Akdemir

Destek Ekibi
Destek Ekibi
Katılım
4 Mayıs 2007
Mesajlar
3,597
Excel Vers. ve Dili
2016 PRO TÜRKÇE-İNG. 64 BİT
Merhaba,

Örnek dosyanızı eklerseniz daha net cevaplar alabilirsiniz.
BETWEEN operatörünü araştırın.
 
Üst