Adodb sorgulama - tarih aralığı

hmtstc

Altın Üye
Katılım
20 Şubat 2014
Mesajlar
314
Excel Vers. ve Dili
Excel 2016 - Türkçe
Altın Üyelik Bitiş Tarihi
10-04-2025
Merhaba,

Aşağıdaki kodu basitçe yazmaya çalıştım başta. Soru olursa yine cevaplarım.
Sistemi açıklayayım

Ayrı bir kayıpliste.xlsx olarak dosyam var, buradan belirli tarih aralığında olan verileri çekmek istiyorum. kayıpliste.xlsx dosyası SAP uygulamasından çekilen bir rapor. Yani o raporu hiç bir şekilde açmadan işlem yapmak istiyorum.

1 hafta +1 gün şeklinde sorgu çekmek istiyorum. Ben gün gün tarihleri girdim ama bunu da başaramadım. Seçilen 2 tarih aralığında raporu çekmek mümkün müdür ?

Dosyaları ekledim, desteğiniz için şimdiden teşekkür ederim.


Sub yenikayıpsorgulama()

Application.ScreenUpdating = False
Set anasayfa = Sheets("1.BÜLTEN")
kullanıcı = Environ("UserName")


Dim gun1, gun2, gun3, gun4, gun5, gun6, gun7, gun8 As String
'Dim kayiptiptanim As String
'Dim kayipdetaytanim As String
'Dim sippno As String
'Dim malzeme As String

anasayfa.Select
gun1 = anasayfa.Cells(7, 37)
gun2 = anasayfa.Cells(8, 37)
gun3 = anasayfa.Cells(9, 37)
gun4 = anasayfa.Cells(10, 37)
gun5 = anasayfa.Cells(11, 37)
gun6 = anasayfa.Cells(12, 37)
gun7 = anasayfa.Cells(13, 37)
gun8 = anasayfa.Cells(14, 37)

Sheets("Kayıplar").Select

'sorgudosyası = Application.GetOpenFilename("Excel Files, *.xlsx", 1, "Lütfen Kaynak Dosyayı Seçiniz", True)
sayfaismi = "Sheet1"
eski = WorksheetFunction.Max(2, Cells(Rows.Count, "A").End(3).Row)
Range(Cells(2, 1), Cells(eski, 11)).ClearContents
yol = ThisWorkbook.Path
hedefkitap = "kayıpliste.xlsx"
tümü = yol & "\" & hedefkitap

Set con = VBA.CreateObject("adodb.Connection")
con.Open "provider=microsoft.ace.oledb.12.0;data source=" & tümü & ";extended properties=""Excel 12.0;hdr=no"""


sorgu = "select F1,F2,F3,F4,F5,F6,F7,F8,F9,F10,F11 " & _
"from[" & sayfaismi & "$A2:K50000] where F5 =" & gun1

''& "' or F5='" & gun2 & "' or F5='" & gun3 & "' or F5='" & gun4 & "' or F5='" & gun5 & "' or F5='" & gun6 & "' or F5='" & gun7 & "' or F5='" & gun8 & "'"

' MsgBox sorgu

Set rs = con.Execute(sorgu)
Range("A2").CopyFromRecordset rs

anasayfa.Select

End Sub
 

Ekli dosyalar

Necdet

Moderatör
Yönetici
Katılım
4 Haziran 2005
Mesajlar
15,371
Excel Vers. ve Dili
Ofis 365 Türkçe
Merhaba,
ADO ile iki tarih aralığında veri çekmek istendiğinde tarihi Double değerine dönüştürmek yeterli.
Aşağıdaki kodları deneyiniz.
Ben sonuca ulaştım.

Kod:
Sub ADOB_ORNEK()

'Referanslardan Microsoft ActiveX Data Objcets .... seçilmelidir
    Dim connection As New ADODB.connection
    Dim DosyaAdi As String
    Dim query As String
    Dim rs As New ADODB.Recordset
    Dim i As Integer
  
    Sayfa2.Range("A1").ClearContents
  
    DosyaAdi = ThisWorkbook.Path & Application.PathSeparator & "kayıpliste.xlsx"
  
    query = "SELECT * FROM [Sheet1$] " & _
            "WHERE [Kayıp Belge Tarihi] >= " & CDbl(Sayfa1.Range("C3")) & " AND [Kayıp Belge Tarihi] <=" & CDbl(Sayfa1.Range("C4")) & " ORDER BY 5"
  
    connection.Open "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & DosyaAdi & _
                ";Extended Properties=""Excel 12.0;HDR=Yes;"";"
              
    rs.Open query, connection
  
    Sayfa2.Range("A2").CopyFromRecordset rs
    i = 0
    For Each baslik In rs.Fields
        i = i + 1
        Sayfa2.Cells(1, i) = baslik.Name
    Next baslik
    connection.Close
  
End Sub
 
Son düzenleme:
Üst