Soru Access veritabanından sorgu?

[s.savas]

Merhaba arkadaşlar.
Ekli dosyadaki Sorgu Grubundan işaretlenen optionbutton tercihine uygun olarak, sorgu textbox'u ile acces veritabanından sorgu yapılması gerekiyor.
Zamanı uygun olan arkadaşların yardımlarını rica ediyorum.

 

[Haluk]

Aşağıdaki gibi bir kod kullanılabilir....

"String" tipindeki verileri MDB'den sorgularken, büyük harfe çevirmek için TextBox'dan AA1 hücresine aktarıp, Excel'in yerleşik UPPER fonksiyonuyla büyük harfe çeviriyoruz çünkü; VBA Türkçe karakterleri büyük harfe çevirirken bazılarında başarısızdır. ("İ" harfi gibi....)

Ben 4-5 tanesini hazırladım, diğerlerini de siz benzer şekilde yaparsınız.

Private Sub txtSorgu_Change()
    Set baglan = CreateObject("adodb.connection")
    Set rs = CreateObject("adodb.recordset")
    
    On Error GoTo SafeExit:
    
    Call BAGLANTI
    
    [AA1] = txtSorgu
    
    If OptionButton1.Value = True Then
        rs.Open "select * from [REHBER] WHERE [REHBER].ADI_SOYADI LIKE '%" & [upper(AA1)] & "%'", baglan, 1, 1
    ElseIf OptionButton2.Value = True Then
        rs.Open "select * from [REHBER] WHERE [REHBER].TC_KIMLIK LIKE '%" & [upper(AA1)] & "%'", baglan, 1, 1
    ElseIf OptionButton3.Value = True Then
        rs.Open "select * from [REHBER] WHERE [REHBER].IL LIKE '%" & [upper(AA1)] & "%'", baglan, 1, 1
    ElseIf OptionButton4.Value = True Then
        rs.Open "select * from [REHBER] WHERE [REHBER].ILCE LIKE '%" & [upper(AA1)] & "%'", baglan, 1, 1
    ElseIf OptionButton5.Value = True Then
        rs.Open "select * from [REHBER] WHERE [REHBER].SICIL LIKE '%" & [upper(AA1)] & "%'", baglan, 1, 1
    '.....
    '...
    '..
    End If
    
    txKimlik = rs(0)
    txtAdi = rs(1) 'Adı Soyadı
    txtTCKimlik = rs(2) 'kimliği
    cmbIL = rs(3) 'il
    cmbILCE = rs(4) 'ilçe
    '.....
    '...
    '..
    
SafeExit:
        If Err.Number = 3265 Then
            MsgBox "Sorgulama için bir seçenek işaretleyin...!"
            Exit Sub
        End If
        rs.Close
        Set rs = Nothing
        Set baglan = Nothing
End Sub

.

 

[s.savas]

Aşağıdaki gibi bir kod kullanılabilir....

"String" tipindeki verileri MDB'den sorgularken, büyük harfe çevirmek için TextBox'dan AA1 hücresine aktarıp, Excel'in yerleşik UPPER fonksiyonuyla büyük harfe çeviriyoruz çünkü; VBA Türkçe karakterleri büyük harfe çevirirken bazılarında başarısızdır. ("İ" harfi gibi....)

Ben 4-5 tanesini hazırladım, diğerlerini de siz benzer şekilde yaparsınız.

Private Sub txtSorgu_Change()
    For i = 1 To 21
        If Me.Controls("OptionButton" & i) = False Then
            x = x + 1
        End If
    Next
  
    If x = 21 Then
        MsgBox "Sorgulama için bir seçenek işaretleyin...."
        Exit Sub
    End If
      
    Set baglan = CreateObject("adodb.connection")
    Set rs = CreateObject("adodb.recordset")
  
    On Error GoTo SafeExit:
  
    Call BAGLANTI
  
    [AA1] = txtSorgu
  
    If OptionButton1.Value = True Then
        rs.Open "select * from [REHBER] WHERE [REHBER].ADI_SOYADI LIKE '%" & [upper(AA1)] & "%'", baglan, 1, 1
    ElseIf OptionButton2.Value = True Then
        rs.Open "select * from [REHBER] WHERE [REHBER].TC_KIMLIK LIKE '%" & [upper(AA1)] & "%'", baglan, 1, 1
    ElseIf OptionButton3.Value = True Then
        rs.Open "select * from [REHBER] WHERE [REHBER].IL LIKE '%" & [upper(AA1)] & "%'", baglan, 1, 1
    ElseIf OptionButton4.Value = True Then
        rs.Open "select * from [REHBER] WHERE [REHBER].ILCE LIKE '%" & [upper(AA1)] & "%'", baglan, 1, 1
    ElseIf OptionButton5.Value = True Then
        rs.Open "select * from [REHBER] WHERE [REHBER].SICIL LIKE '%" & [upper(AA1)] & "%'", baglan, 1, 1
    '.....
    '...
    '..
    End If
  
        txKimlik = rs(0)
        txtAdi = rs(1) 'Adı Soyadı
        txtTCKimlik = rs(2) 'kimliği
        cmbIL = rs(3) 'il
        cmbILCE = rs(4) 'ilçe
        '.....
        '...
        '..
SafeExit:
        If Err Then MsgBox "Aranan veri bulunamadı...!"
        rs.Close
        Set rs = Nothing
        Set baglan = Nothing
End Sub

.

Teşekkür ederim Haluk hocam.
Listede Ahmet ve Ali isminde iki isim olsun. İlk sıradaki kaydı nesnelere yüklüyor. Sorguya iki harf veya rakam veya hedefte olmayan veri girince hata veriyor.

Listbox nesnesinde stabil olarak çalışan kodu Listview için derleyebirseniz minnettar olurum.

Set baglan = CreateObject("adodb.connection")
Set rs = CreateObject("adodb.recordset")

Call baglanti
    rs.Open "select * from [REHBER] WHERE [REHBER].ADI_SOYADI LIKE '%" & txtAdi.Text & "%'", baglan, 1, 1
With ListBox1
    .RowSource = Empty
    .ColumnCount = 24
    .ColumnWidths = "30;30"
    .Column = rs.getrows
End With
    rs.Close
Set rs = Nothing

 

[Haluk]

2. mesajdaki kodu revize etmiştim ..... Tekrar dener misiniz?

.

 

[s.savas]

2. mesajdaki kodu revize etmiştim ..... Tekrar dener misiniz?

.

Tekrar teşekkür ederim hocam.
Angarya olarak görmezseniz, alternatif olarak sorgu sonucunu Listview nesnesine yüklemeyide öğrenmek isterim doğrusu.

 

[Haluk]

Üzgünüm...

Sizde bununla ilgili bir kod vardı ve çalışır hale getirmiştik. Onunla biraz uğraşın bence...

.

 

[s.savas]

Üzgünüm...

Sizde bununla ilgili bir kod vardı ve çalışır hale getirmiştik. Onunla biraz uğraşın bence...

.

Haluk hocam ilginiz ve emeğiniz için teşekkür ederim.
Aşağıdaki şekilde alternatif oluşturabildim.

Private Sub txtSorgu_Change()
If OptionButton1.Value = True Then
ListView1.ListItems.Clear
Set baglan = CreateObject("adodb.connection")
Set rs = CreateObject("adodb.recordset")

Call BAGLANTI
    rs.Open "select * from [REHBER] WHERE [REHBER].ADI_SOYADI LIKE '%" & txtSorgu & "%'", baglan, 1, 1
sorgu
End If

If OptionButton2.Value = True Then
ListView1.ListItems.Clear
Set baglan = CreateObject("adodb.connection")
Set rs = CreateObject("adodb.recordset")

Call BAGLANTI
    rs.Open "select * from [REHBER] WHERE [REHBER].TC_KIMLIK LIKE '%" & txtSorgu & "%'", baglan, 1, 1
sorgu
End If
....
End Sub

Private Sub sorgu()
ListView1.ListItems.Clear
Dim satir As Integer
    On Error Resume Next
    If Not rs.EOF Then
        Do While Not rs.EOF
 Set evn = ListView1.ListItems.Add(, , rs.Fields("KIMLIK"))
 evn.SubItems(1) = rs.Fields("ADI_SOYADI")
 evn.SubItems(2) = rs.Fields("TC_KIMLIK")
 evn.SubItems(3) = rs.Fields("IL")
 evn.SubItems(4) = rs.Fields("ILCE")
 evn.SubItems(5) = rs.Fields("SICIL")
 evn.SubItems(6) = rs.Fields("UNVAN")
 evn.SubItems(7) = rs.Fields("GOREV")
 evn.SubItems(8) = rs.Fields("FIRMA")
 evn.SubItems(9) = rs.Fields("KURUM")
 evn.SubItems(10) = rs.Fields("BASKANLIK")
 evn.SubItems(11) = rs.Fields("BIRIM")
 evn.SubItems(12) = rs.Fields("KAT")
 evn.SubItems(13) = rs.Fields("ODA_NO")
 evn.SubItems(14) = rs.Fields("IS_TEL")
 evn.SubItems(15) = rs.Fields("FAKS")
 evn.SubItems(16) = rs.Fields("DAHILI")
 evn.SubItems(17) = rs.Fields("CEP")
 evn.SubItems(18) = rs.Fields("E_POSTA")
 evn.SubItems(19) = rs.Fields("ADRES")
 evn.SubItems(20) = rs.Fields("VERGI_N")
 evn.SubItems(21) = rs.Fields("VERGI_D")
 evn.SubItems(22) = rs.Fields("NOT")
 
  rs.MoveNext
            
            
        Loop
    End If
    rs.Close: con.Close
    Set rs = Nothing
End Sub