excel userform aracılığı ile mdb dosyasının iki tablosundan veri alma

[hsayar]

Aşağıdaki kodlar ile 3 textbox (1 i giris için) 1 listbox lu userformuma girilen vatnonun ad ve soyad bilgisini tblSAHIS tablosundan getiryorum.

Ancak nasıl bir kod yazmalıyım ki (Kimlik VATNO SCM_ID SCM_IL SCM_ILCE SCM_MUHTARLIK SCM_SANDIKNO SCM_SECMENNO SCM_TARIHI SCM_SANDIKSIRANO SCM_SANDIKALANADI) başlıklarından oluşan tblSECIM adlı tablomda kişi ile ilgili veri var ise lbxSECIM adlı kontrole bütün kayıtlar gelsin.

 Private Const kynKMLIK         As String = _
                                "C:\HSR\HsPrjSAHISTAKIP\HsDatabase\vtKISIGIRIS.mdb"
 
  Private conNFS      As ADODB.Connection            'ADODB bağlantı değişkeni tanımla
  Private recNFS      As ADODB.Recordset             'ADODB kayıt alan değişkeni tanımla
  Private sqlSTR      As String                      'ADO Sorgusundaki başlıklar ve tablo
  Private sqlTBL      As String                      'ADO Sorgusundaki sadece tablo/sayfa
  
  Private boolNFSKYDBAG As Boolean
  
Rem ========================================================= YENİ PROSODÜR
Rem Const olarak tanımlı Veritabanına bağlan

  Sub sbNFSKYTBAG_AC()
    Const PrcStr As String = "sbNFSKYTBAG_AC()"
  
  Dim sorgu$
  
  Rem Tablomuzun/sayfamızın adı ne?
  sqlTBL = " FROM " & "tblSAHIS "
  Rem Tablomuzda/sayfamızda başlıkta sorgulanacak değer?
  sorgu = "VATNO = " & strSHS_TCK
  Rem Tablomuzda/sayfamızda sık kullanılan satır?
  sqlSTR = "SELECT " & sqlBAS & sqlTBL
  
    Rem Veritabanı dosyası belirtilen yoldamı kontrol et, yoksa mesajla uyar, _
        varsa bağlantıyı kur ve bağlantı kuruldu değerini true yap.
    If Dir(kynKMLIK) = "" Then
        MsgBox kynKMLIK & " " & Chr(10) & " Dosyası Bulunamadı.", vbInformation, "Bilgi"
        boolNFSKYDBAG = False
    Else
        Set conNFS = CreateObject("ADODB.Connection")
        With conNFS
            .Provider = "Microsoft.Jet.OLEDB.4.0"
            .Properties("Data Source").Value = kynKMLIK
            .CursorLocation = adUseServer
            .Mode = adModeReadWrite
            .Open
        End With
        boolNFSKYDBAG = True
    End If
  End Sub
  Sub sbNFSKYTBAGKES()
    Const PrcStr As String = "Baglantıyı_Kes()"
    On Error Resume Next
    If CBool(recNFS.State And adStateOpen) = True Then recNFS.Close '?
      Set recNFS = Nothing    'değişkeni hafızadan sil
    If CBool(conNFS.State And adStateOpen) = True Then conNFS.Close '?
      Set conNFS = Nothing  'değişkeni hafızadan sil
  End Sub

Private Sub cmdSORGU_Click()
    If Trim(txtVATNO.Text) = "" Then GoTo exitPROC
    
    sbNFSKYTBAG_AC
    If boolNFSKYDBAG = False Then GoTo exitPROC

    Const sqlBAS1 As String = "tblSAHIS.VATNO, tblSAHIS.SHS_ADI, tblSAHIS.SHS_SOYADI"
        Set recNFS = CreateObject("ADODB.Recordset")    'kayıt bağlantısını kur
        With recNFS
            .ActiveConnection = conNFS
            .CursorLocation = adUseServer
            .CursorType = adOpenKeyset
            .LockType = adLockOptimistic
[B][COLOR=Red]            .Source = "SELECT " & sqlBAS1 & sqlTBL & " WHERE " & "tblSAHIS.VATNO ='" & txtVATNO.Text & "' "[/COLOR][/B]
            .Open
        End With
        
 '***********************************************************************
        If recNFS.RecordCount <> 1 Then                      '1 adet kayıt bulundu ise
          boolNFKYVAR = False
        Else
            If recNFS("SHS_ADI") <> "" Then Me.txtSHS_ADI = recNFS("SHS_ADI")
            If recNFS("SHS_SOYADI") <> "" Then Me.txtSHS_SOYADI = recNFS("SHS_SOYADI")
          boolNFKYVAR = True
        End If
        Call sbNFSKYTBAGKES

exitPROC:
End Sub

Private Sub UserForm_Click()

End Sub

 

[hsayar]

ikinci bir recordset oluşturarak hallettim, peki tek recordsette oluşrurmanın yöntemi yok mu?

Option Explicit

 Private Const kynKMLIK         As String = _
                                "C:\HSR\HsPrjSAHISTAKIP\HsDatabase\vtKISIGIRIS.mdb"
                                
                                
 Private Const sqlBAS_SAHIS     As String = _
                                "tblSAHIS.VATNO, tblSAHIS.SHS_ADI, tblSAHIS.SHS_SOYADI"
                                
 Private Const sqlBAS_SECMEN     As String = _
                                "tblSECMEN.Kimlik, tblSECMEN.VATNO, tblSECMEN.SCM_ID, " & _
                                "tblSECMEN.SCM_IL, tblSECMEN.SCM_ILCE, tblSECMEN.SCM_MUHTARLIK, " & _
                                "tblSECMEN.SCM_SANDIKNO, tblSECMEN.SCM_SECMENNO, " & _
                                "tblSECMEN.SCM_TARIHI, tblSECMEN.SCM_SANDIKSIRANO, " & _
                                "tblSECMEN.SCM_SANDIKALANADI"
 
 Private Const sqlGRP_SECMEN     As String = _
                                "tblSECMEN.SCM_ID, " & _
                                "tblSECMEN.SCM_IL, tblSECMEN.SCM_ILCE, tblSECMEN.SCM_MUHTARLIK, " & _
                                "tblSECMEN.SCM_SANDIKNO, tblSECMEN.SCM_SECMENNO, " & _
                                "tblSECMEN.SCM_TARIHI, tblSECMEN.SCM_SANDIKSIRANO, " & _
                                "tblSECMEN.SCM_SANDIKALANADI"

 
  Private conNFS          As ADODB.Connection            'ADODB bağlantı değişkeni tanımla
  Private recNFS          As ADODB.Recordset             'ADODB kayıt alan değişkeni tanımla
  Private sqlSTR          As String                      'ADO Sorgusundaki başlıklar ve tablo
  Private sqlTBL          As String                      'ADO Sorgusundaki sadece tablo/sayfa
  Private boolNFSKYDBAG   As Boolean
  Private boolNFKYVAR     As Boolean


  Sub sbNFSKYTBAG_AC()
    Const PrcStr As String = "sbNFSKYTBAG_AC()"
    If Dir(kynKMLIK) = "" Then
        MsgBox kynKMLIK & " " & Chr(10) & " Dosyası Bulunamadı.", vbInformation, "Bilgi"
        boolNFSKYDBAG = False
    Else
        Set conNFS = CreateObject("ADODB.Connection")
        With conNFS
            .Provider = "Microsoft.Jet.OLEDB.4.0"
            .Properties("Data Source").Value = kynKMLIK
            .CursorLocation = adUseServer
            .Mode = adModeReadWrite
            .Open
        End With
        boolNFSKYDBAG = True
    End If
  End Sub
  
  Sub sbNFSKYTBAGKES()
    Const PrcStr As String = "Baglantıyı_Kes()"
    On Error Resume Next
    If CBool(recNFS.State And adStateOpen) = True Then recNFS.Close '?
      Set recNFS = Nothing    'değişkeni hafızadan sil
    If CBool(conNFS.State And adStateOpen) = True Then conNFS.Close '?
      Set conNFS = Nothing  'değişkeni hafızadan sil
  End Sub

  Private Sub cmdSORGU_Click()
      If Trim(txtVATNO.Text) = "" Then GoTo exitPROC
      
      sbNFSKYTBAG_AC
      If boolNFSKYDBAG = False Then GoTo exitPROC
      
  Rem *\*\*\*\*\*\*\*\*\*\**\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\
  '   Bağlanılan veritabanının tblSAHIS tablosundan bilgileri çek ve kontrollere getir.
  
      Set recNFS = CreateObject("ADODB.Recordset")    'kayıt bağlantısını kur
      sqlSTR = " SELECT " & sqlBAS_SAHIS & " FROM [tblSAHIS] " & _
               " WHERE " & "tblSAHIS.VATNO ='" & txtVATNO.Text & "' "
          
          With recNFS
            .Open sqlSTR, conNFS, adOpenKeyset, adLockOptimistic
            If .RecordCount <> 1 Then
              boolNFKYVAR = False
              GoTo exitPROC
            Else
              If recNFS("SHS_ADI") <> "" Then Me.txtSHS_ADI = recNFS("SHS_ADI")
              If recNFS("SHS_SOYADI") <> "" Then Me.txtSHS_SOYADI = recNFS("SHS_SOYADI")
              boolNFKYVAR = True
            End If
          End With
          Set recNFS = Nothing
  Rem */*/*/*/*/*/*/*/*/*/**/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/
  
  
  Rem *\*\*\*\*\*\*\*\*\*\**\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\
  '   Bağlanılan veritabanının tblSECIM tablosundan bilgileri çek.
          
      lbxSECMEN.Clear
      Set recNFS = CreateObject("ADODB.Recordset")    'kayıt bağlantısını kur
      sqlSTR = " SELECT " & sqlGRP_SECMEN & _
               " FROM [tblSECMEN] " & _
               " WHERE " & "tblSECMEN.VATNO ='" & txtVATNO.Text & "' " & _
               " GROUP BY " & sqlBAS_SECMEN
      
          With recNFS
            .Open sqlSTR, conNFS, adOpenKeyset, adLockOptimistic
            If .RecordCount <> 0 Then                      'kayıt bulundu ise
              With lbxSECMEN
                .Clear
                .ColumnCount = recNFS.Fields.Count
                '.ColumnWidths = "60;60;60;60;100;60"
                .Column = recNFS.GetRows
                .TextAlign = fmTextAlignRight
                .SpecialEffect = fmSpecialEffectFlat
              End With 'ListBox1
            End If
          End With
          Set recNFS = Nothing
  Rem */*/*/*/*/*/*/*/*/*/**/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/
  
exitPROC:
  Call sbNFSKYTBAGKES
  End Sub