Excel Vba ile Acceste sorgu çalıştırmak

[crpzz37]

Merhabalar ;

Acces üzerindeki veritabanın da bir sorgum bulunmakta. Bu sorugu manuel olarak çalıştır diyip çalıştırmaktayım. Ancak excel userform daki kayıt butonuna bastıktan sonra sorguyu çalıştıramadım. Konuda yardımcı olursanız sevinirim.

 

[crpzz37]

konu ile ilgili yardımcı olabilirseniz çok sevinirim. Acceste manuel olarak çalıştırdığım sorgumu excel üzerinden çalıştırıp sonuçlarını excele geri almak istiyorum.

 

[Mahmut Kök]

Örnek dosya olmadan yardımcı olmak biraz zor oluyor ama Access'teki sorguyu çalıştırmak yerine aynı sorguyu Excel'e yazıp kullanmayı deneyebilirsiniz. Access veri tabanı bağlantısı Excel ile kolayca yapılabilir ve verileri doğrudan okuyup işleyebilirsiniz.

 

[Haluk]

Aşağıdaki örnek kodu inceleyin.....

Burada, Excel dosyası ile aynı yerdeki "Sample.accdb" isimli Access dosyasındaki mevcut "qrRegions" isimli sorgu çalıştırılarak, veriler Excel'e alınmaktadır.

Kodun çalışması için VBA editöründe Tools>References bölümünden "Microsoft ActiveX Data Objects 6.1 Library" referansı eklenmelidir.

Sub Test()
'   Haluk - 08/07/2020
'
'   Reference: Microsoft ActiveX Data Objects 6.1 Library

    Dim objADO As ADODB.Connection
    Dim objRS As ADODB.Recordset
    Dim strFile As String
    Dim strSQL As String
    
    Set objADO = New ADODB.Connection
    Set objRS = New ADODB.Recordset
    
    strFile = ThisWorkbook.Path & "\" & "Sample.accdb"
    
    With objADO
        If Val(Application.Version) < 14 Then
            .Provider = "Microsoft.Jet.OLEDB.4.0"
        Else
            .Provider = "Microsoft.Ace.OLEDB.12.0"
        End If
       .ConnectionString = strFile
       .Open
    End With
    
    strSQL = "qrRegions"
    
    With objRS
       .CursorType = adOpenStatic
       .CursorLocation = adUseClient
       .LockType = adLockBatchOptimistic
       .ActiveConnection = objADO
       .Source = strSQL
       .Open
    End With
    
    If objRS.RecordCount > 0 Then
        For j = 0 To objRS.Fields.Count - 1
            Cells(1, j + 1) = objRS.Fields(j).Name
        Next
        Range("A2").CopyFromRecordset objRS
    End If
    
    If objRS.State = adStateOpen Then objRS.Close
    If objADO.State = adStateOpen Then objADO.Close
    
    Set objRS = Nothing
    Set objADO = Nothing
End Sub

.

 

[crpzz37]

Aşağıdaki örnek kodu inceleyin.....

Burada, Excel dosyası ile aynı yerdeki "Sample.accdb" isimli Access dosyasındaki mevcut "qrRegions" isimli sorgu çalıştırılarak, veriler Excel'e alınmaktadır.

Kodun çalışması için VBA editöründe Tools>References bölümünden "Microsoft ActiveX Data Objects 6.1 Library" referansı eklenmelidir.

Sub Test()
'   Haluk - 08/07/2020
'
'   Reference: Microsoft ActiveX Data Objects 6.1 Library

    Dim objADO As ADODB.Connection
    Dim objRS As ADODB.Recordset
    Dim strFile As String
    Dim strSQL As String
   
    Set objADO = New ADODB.Connection
    Set objRS = New ADODB.Recordset
   
    strFile = ThisWorkbook.Path & "\" & "Sample.accdb"
   
    With objADO
        If Val(Application.Version) < 14 Then
            .Provider = "Microsoft.Jet.OLEDB.4.0"
        Else
            .Provider = "Microsoft.Ace.OLEDB.12.0"
        End If
       .ConnectionString = strFile
       .Open
    End With
   
    strSQL = "qrRegions"
   
    With objRS
       .CursorType = adOpenStatic
       .CursorLocation = adUseClient
       .LockType = adLockBatchOptimistic
       .ActiveConnection = objADO
       .Source = strSQL
       .Open
    End With
   
    If objRS.RecordCount > 0 Then
        For j = 0 To objRS.Fields.Count - 1
            Cells(1, j + 1) = objRS.Fields(j).Name
        Next
        Range("A2").CopyFromRecordset objRS
    End If
   
    If objRS.State = adStateOpen Then objRS.Close
    If objADO.State = adStateOpen Then objADO.Close
   
    Set objRS = Nothing
    Set objADO = Nothing
End Sub

.

haluk bey çok teşekkür ederim çok sağolun