• DİKKAT

    DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
    Altın Üyelik Hakkında Bilgi

ado sorgusunun bir kez çlıştıktan sonra hata vermesi

H

hsayar

Katılım
2 Mart 2005
Mesajlar
2,960
Excel Vers. ve Dili
ev: Ofis 2007- Win Xp
iş: Ofis 2010- Win Vista
Kod: 
Public Type hsr_KMLKveri
    tTCKNO    As String     'tSHS_TCK
    tSHS_UYR  As String
    tSHS_CNS     As String     'tSHS_CNS
    tADI      As String     'tSHS_ADI
    tSYD      As String     'tSHS_SYD
    tISYD     As String     'tSHS_ISD
    tBAD      As String     'tSHS_BAD
    tAAD      As String     'tSHS_AAD
    tDYR      As String     'tSHS_DYR
    tDTR      As Date       'tSHS_DTR
    tMHL As String          'tSHS_MHL
    tDN As String           'tSHS_DIN
    tKGR As String          'tSHS_KGR
    tNIL As String          'tNUF_ILI
    tNILC As String         'tNUF_ILC
    tNMK As String          'tNUF_MKY
    tNCS As String          'tNUF_CSN
    tNAS As String          'tNUF_ASN
    tNBS As String          'tNUF_BSN
    tAIL As String          'tADR_ILI
    tAILC As String         'tADR_ILC
    tABLD As String         'tADR_BLD
    tAMK As String          'tADR_MKY
    tACS As String          'tADR_CSK
    tAKN As String          'tADR_AKN
    tADN As String          'tADR_ADN
    tAPK As String          'tADR_APK
    tTEV1 As String         'tILT_EV1
    tTEV2 As String         'tILT_EV2
    tTIS1 As String         'tILT_IS1
    tTIS2 As String         'tILT_IS2
    tTCP1 As String         'tILT_CP1
    tTCP2 As String         'tILT_CP2
    tTBG1 As String         'tILT_BG1
    tTBG2 As String         'tILT_BG2
    tEMK1 As String         'tILT_EM1
    tEMK2 As String         'tILT_EM2
    tNFC_SRI As String
    tNFC_SNO As String
    tNFC_VYR As String
    tNFC_VND As String
    tNFC_KNO As String
    tNFC_KTR As Date
    tLST_ADI As String          'tLST_ADI
    tLST_NUM As String          'tLST_NUM
    tLST_TRH As Date            'tLST_TRH
End Type
Kod: 
Sub sbNFSKYTAL() '(tcno)
'**********************************************************************************
' bu prosodür kimlik veritabanındaki bilgileri çekerek hsr_KMLKveri tipindeki verilere atar.
' kimlik sorgusu olumlu ise boolNFKYVAR değerini true olarak değiştirir.
' Bu prasodürün sağlıklı çalışması için
' 1) mdlSABITLER modülünde Public boolNFKYVAR As Boolean,
'    Public tKMLK As hsr_KMLK veri değişkenlerinin tanımlanması
' 2) mdlTYPE modülünde hsr_KMLKveri isimli özle tip değişkenin tanımlanması
'
' gerekmektedir.
' son düzenlenme tarihi 17/02/2010 dur.
'***********************************************************************************

'NUFUS KAYITLARINI AL
  Dim conNFS As ADODB.Connection                                                    'ADODB bağlantı değişkeni tanımla
  Dim recNFS As ADODB.Recordset                                                       'ADODB kayıt alan değişkeni tanımla
  Dim intKayNo As Integer                                                             'Kaynak Dosya Numarası
  Dim sayfaadi$, SQLStr$, sorgu$, basliklar$

'  Dim tKMLK As hsr_KMLKveri
'›››››››››››››››››››››››››››››››››››››››››››››››››››››››››››››››››››››››››››››››››››››››››››››››››››››››››››››››››››››››››››
  intKayNo = 1
KaynakSec:
  Select Case intKayNo
    'Kaynak olarak bu kitabın olduğu klasörde veri tabanı belirt
    Case Is = 1: strVTTCK = "C:\VT\vttc0709.xls"
'    Case Is = 2: strVTTCK = "C:\VT\vttc2007.xls"
'    Case Is = 3: strVTTCK = "C:\VT\vttcEKLR.xls"
  End Select

'\ Seçilen kaynak mevcut mu?
  If Dir(strVTTCK) = "" Then
    MsgBox strVTTCK & " " & Chr(10) & " Dosyası Bulunamadı.", vbInformation, "Bilgi"
    Exit Sub
  End If


'Sorgulanacak başlıkları ve sorgulanacak kriteri yaz
basliklar = "TCKİMLİKNO, SHS_UYR, C, ADI, SOYADI, ILKSOYADI, ANNEADI, BABAADI, DOGUMYERİ, DOGUMTARİHİ, "
basliklar = basliklar & "MDN_HAL, DIN, KAN_GRB, NFS_MHKY, NFS_ILCE, NFS_IL,  NFS_CSN, NFS_ASN, NFS_BSN, "
basliklar = basliklar & "ADR_BLD, ADR_MUHTAR, ADR_ILCE, ADR_IL, ADR_CD_SKK, ADR_KNO, ADR_DNO, ADR_PSK,"
basliklar = basliklar & "TEL_EV1, TEL_EV2, TEL_IS1, TEL_IS2, TEL_CP1, TEL_CP2, TEL_BG1, TEL_BG2, ELMEK1,  ELMEK2,"
basliklar = basliklar & "NFC_SRI, NFC_SNO, NFC_YER, NFC_VND, NFC_KNO, NFC_KTR, LST_ADI, LST_NUM, LST_TRH"

sayfaadi = "[data$] "
sorgu = "TCKİMLİKNO = " & vatno
SQLStr = "SELECT " & basliklar & " FROM " & sayfaadi & " WHERE " & sorgu

'\ Bağlantıyı Kur
Set conNFS = CreateObject("ADODB.Connection")
    With conNFS
        .Provider = "Microsoft.Jet.OLEDB.4.0"
        .Properties("Extended Properties").Value = "Excel 8.0"
        .Properties("Data Source").Value = strVTTCK
        .CursorLocation = adUseServer
        .Mode = adModeReadWrite
        .Open
    End With

    If Err = 0 Then                                     'eğer bağlantıda hata yoksa
        Set recNFS = CreateObject("ADODB.Recordset")    'kayıt bağlantısını kur
        With recNFS
            .ActiveConnection = conNFS
            .CursorLocation = adUseServer
            .CursorType = adOpenKeyset
            .LockType = adLockOptimistic
            .Source = SQLStr

            .Open
        End With
 '***********************************************************************
        If recNFS.RecordCount = 1 Then                      '1 adet kayıt bulundu ise
          With tKMLK
            If recNFS("SHS_UYR") <> "" Then .tSHS_UYR = recNFS("SHS_UYR")
            If recNFS("C") <> "" Then .tSHS_CNS = recNFS("C")
            If recNFS("ADI") <> "" Then .tADI = recNFS("ADI")
            If recNFS("SOYADI") <> "" Then .tSYD = recNFS("SOYADI")
            If recNFS("ILKSOYADI") <> "" Then .tISYD = recNFS("ILKSOYADI")
            If recNFS("BABAADI") <> "" Then .tBAD = recNFS("BABAADI")
            If recNFS("ANNEADI") <> "" Then .tAAD = recNFS("ANNEADI")
            If recNFS("DOGUMYERİ") <> "" Then .tDYR = recNFS("DOGUMYERİ")
            If recNFS("DOGUMTARİHİ") <> "" Then .tDTR = Format(recNFS("DOGUMTARİHİ"), "DD/MM/YYYY")
            If recNFS("MDN_HAL") <> "" Then .tMHL = recNFS("MDN_HAL")
            If recNFS("DIN") <> "" Then .tDN = recNFS("DIN")
            If recNFS("KAN_GRB") <> "" Then .tKGR = recNFS("KAN_GRB")
'Nüfusa Kayıtlı Olduğu
            If recNFS("NFS_IL") <> "" Then .tNIL = recNFS("NFS_IL")
            If recNFS("NFS_ILCE") <> "" Then .tNILC = recNFS("NFS_ILCE")
            If recNFS("NFS_MHKY") <> "" Then .tNMK = recNFS("NFS_MHKY")
            If recNFS("NFS_CSN") <> "" Then .tNCS = recNFS("NFS_CSN")
            If recNFS("NFS_ASN") <> "" Then .tNAS = recNFS("NFS_ASN")
            If recNFS("NFS_BSN") <> "" Then .tNBS = recNFS("NFS_BSN")
'Adres Bilgileri
            If recNFS("ADR_IL") <> "" Then .tAIL = recNFS("ADR_IL")
            If recNFS("ADR_ILCE") <> "" Then .tAILC = recNFS("ADR_ILCE")
            If recNFS("ADR_BLD") <> "" Then .tABLD = recNFS("ADR_BLD")
            If recNFS("ADR_MUHTAR") <> "" Then .tAMK = recNFS("ADR_MUHTAR")
            If recNFS("ADR_CD_SKK") <> "" Then .tACS = recNFS("ADR_CD_SKK")
            If recNFS("ADR_KNO") <> "" Then .tAKN = recNFS("ADR_KNO")
            If recNFS("ADR_DNO") <> "" Then .tADN = recNFS("ADR_DNO")
            If recNFS("ADR_PSK") <> "" Then .tAPK = recNFS("ADR_PSK")
'Telefon ve elektronik mektup bilgileri
            If recNFS("TEL_EV1") <> "" Then .tTEV1 = recNFS("TEL_EV1")
            If recNFS("TEL_EV2") <> "" Then .tTEV2 = recNFS("TEL_EV2")
            If recNFS("TEL_IS1") <> "" Then .tTIS1 = recNFS("TEL_IS1")
            If recNFS("TEL_IS2") <> "" Then .tTIS2 = recNFS("TEL_IS2")
            If recNFS("TEL_CP1") <> "" Then .tTCP1 = recNFS("TEL_CP1")
            If recNFS("TEL_CP2") <> "" Then .tTCP2 = recNFS("TEL_CP2")
            If recNFS("TEL_BG1") <> "" Then .tTBG1 = recNFS("TEL_BG1")
            If recNFS("TEL_BG2") <> "" Then .tTBG2 = recNFS("TEL_BG2")
            If recNFS("ELMEK1") <> "" Then .tEMK1 = recNFS("ELMEK1")
            If recNFS("ELMEK2") <> "" Then .tEMK2 = recNFS("ELMEK2")
''NFC_SRI NFC_SNO NFC_YER NFC_VND NFC_KNO NFC_KTR
            If recNFS("NFC_SRI") <> "" Then .tNFC_SRI = recNFS("NFC_SRI")
            If recNFS("NFC_SNO") <> "" Then .tNFC_SNO = recNFS("NFC_SNO")
            If recNFS("NFC_YER") <> "" Then .tNFC_VYR = recNFS("NFC_YER")
            If recNFS("NFC_VND") <> "" Then .tNFC_VND = recNFS("NFC_VND")
            If recNFS("NFC_KNO") <> "" Then .tNFC_KNO = recNFS("NFC_KNO")
            If recNFS("NFC_KTR") <> "" Then .tNFC_KTR = Format(recNFS("NFC_KTR"), "DD/MM/YYYY")
' LST_ADI, LST_NUM, LST_TRH
            If recNFS("LST_ADI") <> "" Then .tLST_ADI = recNFS("LST_ADI")
            If recNFS("LST_NUM") <> "" Then .tLST_NUM = recNFS("LST_NUM")
            If recNFS("LST_TRH") <> "" Then .tLST_TRH = Format(recNFS("LST_TRH"), "DD/MM/YYYY")
          End With
          boolNFKYVAR = True
        Else
            If intKayNo <= 1 Then
              intKayNo = intKayNo + 1
              GoTo KaynakSec
            Else
             MsgBox vatno & " Kimlik Numaralı kayıt Bulunamadı.", vbInformation, "VERİ GİRİŞ"       'uyarı ver
             boolNFKYVAR = False
            End If
        End If
    Else                                                        'bağlantıda hata varsa
sonNFS:
    MsgBox "Bağlantı Hatası.Kontrol Ediniz", vbInformation, "Bilgi" 'uayrı ver
End If

'\ Bağlantıyı kapat
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
yukarıdaki modüldeki makro ile aşağıdaki userform üzerindeki makro ile userforma veri alıyorum.

Kod: 
Private Sub vatnodolumu()
boolNFKYVAR = False

If txtVATNO.Text <> "" Then
  vatno = txtVATNO.Text
  Call sbNFSKYTAL
  If boolNFKYVAR = True Then
    Call formKIMLIKGIRIS.sbNFSKYTYAZ(tKMLK)
    cmdKYTDEG.Caption = "D E Ğ İ Ş T İ R"
  Else
    cmdKYTDEG.Caption = "KAYDET"
'    Call sbthsr_KMLKveri_Reset
'    HSR_TCVGF.sbVttestcagır (vatno)
  End If
End If
End Sub
userform initalize veya cmsSORGU butonlarından koldar ilkte çalışıyır. fakat tc nosunu değiştirip tekrar cmdSORGU butonuna basınca bağlantı hatası veriyor neden olabilir?

kodlarda naıl bir değişklik yaparsam aşğaıdaki sonucu alırım?
kodu eğer çalışmakta olduğum çalışma kitabından tcnosunu göndererek görüntüle dersem userforma ilgili veriler gelecek, yada vatno textboxına tc nosunau girincede ilgili veriler gelecek, ancak sorgulama prosodürü birtane olacak

Örnek dosya isterseniz hazılamam vakit alabilir...
bunun için iki tane xla dosyası bir tane örnek veritabanı dosyası ve bir tane örnek sorgu dosyası yüklenmesi gerekir... biraz da ocx ama hangileri unuttum :(eğer isteyen usta olursa hazırlamaya çalışırım.
 
Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst