Function Geri donus alma

[ASMET67]

merhaba.
Acces databesine Fonksiyon ile gönderdiğim Sql Kodunudun dataya kayıt edildiğine dair geri donus işlemini fonsiyondan nasıl alabilirim.


Bir değişkenin data atılan her kayıt icin bir artırılmasını ve islemin bittiğinde toplam sayının sayfadaki veri sayısı ile eşit olup olmadığını kontrol etmek istiyorum. Nasıl yapabilirim.


Call VeriIslemi(sorgu, Database)

Function VeriIslemi(Sorgum As String, Database As String) As String
Dim Baglantim As ADODB.Connection
Dim Ksm As ADODB.Recordset
Set Baglantim = New ADODB.Connection
Set Ksm = New ADODB.Recordset
On Error GoTo err
Baglantim.Open "DRIVER={Microsoft Access Driver (*.mdb)};" & "DBQ=" & ThisWorkbook.Path & "\" & Database
Set Ksm = Baglantim.Execute(Sorgum)
KontrolSay = 1
' Kontrol (KontrolSay)
Baglantim.Close
err:
If err Then MsgBox "Bir Problem Oluştu!" & vbNewLine & err.Description & vbNewLine & "Sorgu:" & Sorgum
End Function

 

[Levent Menteşoğlu]

mdb dosyasındaki kayıt sayısını her kayıttan sonra sayacak bir sorgu daha ekleyin ve bu sorgu sonucunu bir değişkene aktarın. Bunun için sorgu içinde count fonksiyonunu kullanabilirsiniz.

 

[ASMET67]

Data Buyuk olduğu için sorgu donusu uzun suruyor.
Sorgu gondermeden bir çözümü yokmu. fonksiyon Hata verdiğinde değişkeni artırsak o değişkenin değerini fonsiyon çalıştırmayı gönderdiğim komuttan sonra tekrar okutmak mümkün mü?

 

[Levent Menteşoğlu]

sorgum ifadesindeki sorguyu yazarsanız ben sayma sorgusunu yazarım. Eğer verileri bir döngü ile alıyorsanız işlem uzun sürebilir. Benim önereceğim yapıda uzun sürmeyecektir.

 

[ASMET67]

Accese kayıt kodu ektedir.
Bu kodda nasıl bir değişiklik yapabiliriz.

im adoCN As Object
Dim RS As Object
Dim Str As Long
Dim strSQL As String
Dim CurrRec As String
Dim sorgu As String
Dim S1 As Worksheet
Dim Database As String
Set S1 = ThisWorkbook.Worksheets("Sql")
  Dim KayitNo, KayitVarmi As Long
Dim Tutar As Double
' KayTar , GuncTar, EvrBasTar
    Set adoCN = CreateObject("ADODB.Connection")
    Database = "DataBase.mdb"
    
    DatabasePath = ThisWorkbook.Path & "\" & Database
    If Dir(DatabasePath) = "" Then
        MsgBox DatabasePath & " bulunamadı, programdan çıkılacak !", vbCritical, "TestDB"
     
        Exit Sub
    End If
    
   say = S1.Cells(65536, "E").End(3).Row
   If say = 5 Then
   MsgBox "Kabul edilecek detay veri bulunamadı"
   Exit Sub
   End If
   
   
    adoCN.Provider = "Microsoft.Jet.OLEDB.4.0"
    adoCN.ConnectionString = DatabasePath
    adoCN.Open
   Set RS = CreateObject("ADODB.recordset")
         
  
  
  TARIH = S1.Cells(1, "A").Value
'      sorgu = "SELECT Max(Id) FROM Data Where not isnull(Id) And TARIH=" & CDbl(CDate(Tarih))
'
'        KayitNo = Val(KayitOku(sorgu, Database))
       
  
  
     strSQL = "SELECT * FROM Data Where not isnull(Id) And TARIH=" & CDbl(CDate(TARIH))
     'MsgBox S1.Cells(4, "a").Value
     On Error Resume Next
     RS.Close
     On Error GoTo 0
     RS.Open strSQL, adoCN, 1, 3
    RP = RS.RecordCount
    RS.Close
   kabul = 0
  If RP = 0 Then
YenidenEkle:
For i = 6 To say
 
On Error GoTo 0
TARIH = S1.Cells(1, "A")
CODCLI = S1.Cells(i, "A")
TOULIV = S1.Cells(i, "B")
CRS = S1.Cells(i, "C")
NOMCLI = S1.Cells(i, "D")
RP = S1.Cells(i, "E")
KOLI_TP = Replace(S1.Cells(i, "F"), ",", ".")
CROSS_TP = Replace(S1.Cells(i, "G"), ",", ".")
CROSS_GKP = Replace(S1.Cells(i, "H"), ",", ".")
TAHMINI_TOPLAM = Replace(S1.Cells(i, "I"), ",", ".")
KOLI_GERCEK = Replace(S1.Cells(i, "J"), ",", ".")
KOLI_FARK = Replace(S1.Cells(i, "K"), ",", ".")
SEBZE_TP = Replace(S1.Cells(i, "L"), ",", ".")
SEBZE_GERCEK = Replace(S1.Cells(i, "M"), ",", ".")
SEBZE_FARK = Replace(S1.Cells(i, "N"), ",", ".")
GENEL_TOPLAM = Replace(S1.Cells(i, "O"), ",", ".")
ACIKLAMA = S1.Cells(i, "P")
 
    sorgu = "Insert Into Data (TARIH,CODCLI,TOULIV,CRS,NOMCLI,RP,KOLI_TP,"
    sorgu = sorgu & " CROSS_TP,CROSS_GKP,TAHMINI_TOPLAM,KOLI_GERCEK,KOLI_FARK,"
    sorgu = sorgu & " SEBZE_TP,SEBZE_GERCEK,SEBZE_FARK,GENEL_TOPLAM,ACIKLAMA)"
    sorgu = sorgu & " Values (" & CDbl(CDate(TARIH)) & "," & CODCLI & "," & TOULIV
    sorgu = sorgu & "," & CRS & ",'" & NOMCLI & "','" & RP
    sorgu = sorgu & "'," & KOLI_TP & "," & CROSS_TP & "," & CROSS_GKP
    sorgu = sorgu & "," & TAHMINI_TOPLAM & "," & KOLI_GERCEK & ","
    sorgu = sorgu & KOLI_FARK & "," & SEBZE_TP & "," & SEBZE_GERCEK
    sorgu = sorgu & "," & SEBZE_FARK & "," & GENEL_TOPLAM & ",'" & ACIKLAMA & "')"
          
           ' MsgBox sorgu
           
           Kntrl = 0
           Call VeriIslemi(sorgu, Database)
          a = KontrolSay
           If 1 = False Then
            kabul = kabul + 1
            End If
           
     Next i
        '    Call CmdYeni_Click
    
Else
 
x = MsgBox("Daha Önce Kabul edilmiştir" & Chr(10) & "Önceki Kaydı Silip Tekrar Kabul Etmek İstiyormusunuz", vbYesNo)
If x = vbYes Then
sorgu = "Delete FROM Data Where not isnull(Id) And TARIH=" & CDbl(CDate(TARIH))
Call VeriIslemi(sorgu, Database)
GoTo YenidenEkle
End If
End If
 
  adoCN.Close
   Set kayit = Nothing

 

[Levent Menteşoğlu]

Kayıt işlemini bitiren satırlardan sonra aşağıdaki satırları ilave ederek denermisiniz.

Set say = adoCN.Execute("select count(Id) from Data")
MsgBox say.fields(0)