• DİKKAT

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

İşyerinde çalıştırdığım dosyayı evde yeni ofis kurduğum makinede çalıştıramıyorum :(

Katılım
2 Mart 2005
Mesajlar
2,960
Excel Vers. ve Dili
ev: Ofis 2007- Win Xp
iş: Ofis 2010- Win Vista
İşyerinde sorunsuz çalışan programım burada çalışmıyor
veritabanlalarını "c:\vt\ içineattım

Mic. ActX Data Ob 2.8 refarasınıda ekledim ama hala kırmızı satırda hata veriyor sorun ne olabilir?


Kod:
Private Sub sbNFSKYTAL() '(tcno)
boolIPTAL = False
'NUFUS KAYITLARINI AL
  Dim Baglanti As ADODB.Connection                                                    'ADODB bağlantı değişkeni tanımla
  Dim Kayit1 As ADODB.Recordset                                                       'ADODB kayıt alan değişkeni tanımla
  Dim intKayNo As Integer                                                             'Kaynak Dosya Numarası
  Dim SQLStr As String                                                                'Sorgulanacak alanlar
'›››››››››››››››››››››››››››››››››››››››››››››››››››››››››››››››››››››››››››››››››››››››››››››››››››››››››››››››››››››››››››

  intKayNo = 1
KaynakSec:
  Select Case intKayNo
    'Kaynak olarak bu kitabın olduğu klasörde veri tabanı belirt
    Case Is = 1: strVTTCK = "C:\VT\vttc2009.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, ADI, SOYADI, ANNEADI, BABAADI, DOGUMYERİ, DOGUMTARİHİ, "
basliklar = basliklar & "NFS_MHKY, NFS_ILCE, NFS_IL, "
basliklar = basliklar & "ADR_MUHTAR, ADR_ILCE, ADR_IL, ADR_CD_SKK, ADR_KNO, ADR_DNO"
sayfaadi = "[data$] "
sorgu = "TCKİMLİKNO = " & VatNo
SQLStr = "SELECT " & basliklar & " FROM " & sayfaadi & " WHERE " & sorgu

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

    If Err = 0 Then                                     'eğer bağlantıda hata yoksa
        Set Kayit1 = CreateObject("ADODB.Recordset")    'kayıt bağlantısını kur
        With Kayit1
            .ActiveConnection = Baglanti
            .CursorLocation = adUseServer
            .CursorType = adOpenKeyset
            .LockType = adLockOptimistic
            .Source = SQLStr
            
            .Open
        End With
 '***********************************************************************
bassut = 3
        If Kayit1.RecordCount = 1 Then                      '1 adet kayıt bulundu ise
'Kimlik Bilgileri
          Cells(HdfSatNo, bassut + 0).Value = Kayit1("ADI")          'bulunanları yaz
          Cells(HdfSatNo, bassut + 1).Value = Kayit1("SOYADI")       '..   ""...
          Cells(HdfSatNo, bassut + 2).Value = Kayit1("BABAADI")      '..   ""...
          Cells(HdfSatNo, bassut + 3).Value = Kayit1("ANNEADI")      '..   ""...
          Cells(HdfSatNo, bassut + 4).Value = Kayit1("DOGUMYERİ")    '..   ""...
          Cells(HdfSatNo, bassut + 5).Value = Format(Kayit1("DOGUMTARİHİ"), "DD/MM/YYYY") 'Kayit1("DOGUMTARİHİ")  '..   ""...
'Nüfusa Kayıtlı Olduğu
          Cells(HdfSatNo, bassut + 6).Value = Kayit1("NFS_IL")   '..   ""...
          Cells(HdfSatNo, bassut + 7).Value = Kayit1("NFS_ILCE")
          Cells(HdfSatNo, bassut + 8).Value = Kayit1("NFS_MHKY")  '..   ""...
'Adres Bilgileri
          Cells(HdfSatNo, bassut + 9).Value = Kayit1("ADR_IL")   '..   ""...
          Cells(HdfSatNo, bassut + 10).Value = Kayit1("ADR_ILCE")
          Cells(HdfSatNo, bassut + 11).Value = Kayit1("ADR_MUHTAR")  '..   ""...
          Cells(HdfSatNo, bassut + 12).Value = Kayit1("ADR_CD_SKK")  '..   ""...
          Cells(HdfSatNo, bassut + 13).Value = Kayit1("ADR_KNO") & "/" & Kayit1("ADR_DNO")   '..   ""...
'=P2&EĞER(#BAŞV!<>"";"/"&#BAŞV!;"")
          'Cells(HdfSatNo, bassut + 14).Value =
        Else
            If intKayNo <= 3 Then
              intKayNo = intKayNo + 1
              GoTo KaynakSec
            Else
              MsgBox "Aradığınız NÜFUS KAYDI Bulunamadı.", vbInformation, "Bilgi"       'uyarı ver
              boolIPTAL = True
              'formKIMLIKGIRIS.Show                                                      'kayıt eklemek için user forma geç
            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(Kayit1.State And adStateOpen) = True Then Kayit1.Close '?
Set Kayit1 = Nothing    'değişkeni hafızadan sil
If CBool(Baglanti.State And adStateOpen) = True Then Baglanti.Close '?
Set Baglanti = Nothing  'değişkeni hafızadan sil

End Sub
'Hs®yaz
 
.Properties("Extended Properties").Value = "Excel 8.0"

satırında aşağıdaki hatayı veriyor yüklü referanslarda resimde gösterilmiştrir.
 

Ekli dosyalar

  • rte3706.JPG
    rte3706.JPG
    9.9 KB · Görüntüleme: 17
  • uyevt_ref.JPG
    uyevt_ref.JPG
    35.6 KB · Görüntüleme: 42
.Properties("Extended Properties").Value = "Excel 8.0"

satırında aşağıdaki hatayı veriyor yüklü referanslarda resimde gösterilmiştrir.

Merhabalar,

Arkadaşım eline emeğine sağlık. 2009 da yapılan bir paylaşım 4 sene sonra ne kadar işe yarıyor. O kadar aradım cevap hiçbiryerde yok tekrar sağol.
 
Geri
Üst