otomatik Veri Almada Bağlantı Sorunu

[tamersyilmaz]

Ekteki örnekte çalışma gurubu bilgisayarı kapatılırsa ağdan veri almada hata yaşıyorum ben bilgisayar kapatılırsa bilgiayarın hata vermesini değil belli bir süre sonra tekrar bağlantı olup olmadığını kontrol ederek bağlantı varsa veri almasına devam etmesini istiyorum.

 

[modalı]

Sayın tamersyilmaz,

Bir aşağıdaki kodları deneyin. Fonksiyonu Timer ın içinden çağırın.

Function BelgeVarmi() As Boolean


DoCmd.GoToRecord , , acNewRec
            DoCmd.DoMenuItem acFormBar, acRecordsMenu, acSaveRecord, , acMenuVer70
                Me.ID = 1



Const ForReading = 1, ForWriting = 2, ForAppending = 8
    Dim fs, f
    Dim name, text, path As String
    Dim txtLen As Long
    Dim cnn As New ADODB.Connection
    Dim rst As New Recordset

    On Error GoTo BaglantiYok 'Bağlantı yoksa hata üretecektir
    

    'path a bulunduğumuz vt nın yolunu atıyoruz,
    'name e açılacak olan text dosyamızın adını ve yolunu atıyoruz
    
    path = "\\Borrell-6c96x\BADEM KIRMA"
    name = path & "\BASCBUFF.txt"
    
    'fs ye dosya sisteminin bir nesnesi olarak ayarlıyoruz
    'f ye metin dosyası olarak name değişkenine atadığımız dosyayı okumak üzere(1) açıyoruz
    'yukarıdaki sabitlere yaptığımız tanımlar üzere
    
    Set fs = CreateObject("Scripting.FileSystemObject")
    Set f = fs.OpenTextFile(name, 1, -2)
    
    'cnn yi mevcut vt bağlantısı olarak ayarlıyoruz
    'rst olarak cnn bağlantısında bulunan tblAlınan Veriler tablosunu ekleme yapmak üzere
    'açıyoruz.
    
    Set cnn = CurrentProject.Connection
    rst.Open "tblAlınanVeriler", cnn, adOpenKeyset, adLockOptimistic, adCmdTableDirect
    
    'f dosyasının sonu gelene kadar çevrimi çalıştırıyoruz(bugün AtEndofStream i arıyordum)
    
    Do While Not f.AtEndofStream
    
    'text değişkenine f deki satırları okuyup metni atamasını sağlıyoruz
    
    text = f.readLine
    
               
            'rst kayıt kümesine yeni bir kayıt ekliyoruz parantez içine
            '0 başlayarak alan indexlerini veya adlarını yazabiliyoruz
            'Trim le aldığımız metnin sağ ve solundaki boşlukları temizliyoruz
           
            text = Trim(text)
            
         
            rst.AddNew
          
                rst("deneme") = text
                rst("SIRA") = Me.SIRA2
            rst.Update
    
   
    Loop
    
    'f metin dosyasını kapatıyoruz
    f.Close
    'veritabanını kapatıyoruz
    'İlerde hataların önüne geçmek için mutlaka işin sonunda
    'tüm ayarları hiçbirşey ile eşitlememiz gerekiyor
    
   BelgeVarmi= True

    f.Close
    Set f = Nothing
    Set fs = Nothing
    rst.Close        
    Set rst = Nothing
    Set cnn = Nothing
    
  Forms![Form2]![Form1].Form![SIRA] = Me.SIRA2
  Exit Function
BaglantiYok:
'If table is not there close out and set function to false
   Set f = Nothing
    Set fs = Nothing
    rst.Close        
    Set rst = Nothing
    Set cnn = Nothing

     BelgeVarmi= False
Exit Function
End Function

İyi çalışmalar

 

[tamersyilmaz]

Teşekkür

Sayın Modali Hocam Yine Emeğiniz ve yardımlarınız için çok teşekkür ederim. Ufak bir düzenleme ile istediğim oldu.