Değerli uzman arkadaşlar şifreli Access veri tabanından excele nasıl veri çekebilirim. Çok araştırmama ragmen internetteki örnekleri kendime uyarlayamadım. Access şifresi:1234
Şifreli Access Veri Tabanından Veri Çekmek
aşağıdaki kodu dener misiniz?
Sub CommandButton1_Click()
' Vba Tools sekmesindeki "Referanslar bölümüne tıklayın"
' "Microsoft Office xx.0 Access database engine Object Library" alanını seçmeniz gereklidir.
Dim DataBaglan As DAO.Database
Dim DataKayitlari As DAO.Recordset
'
Set DataBaglan = OpenDatabase(ThisWorkbook.Path & "\ANA SAYFA.accdb", False, False, "MS Access;PWD=" & 1234) '<-- düzenlenen kısım
'Set DataBaglan = OpenDatabase("C:\Users\mert\Desktop\veri\ANA SAYFA.accdb")
'EgitimListesi tablosu içerisinde veri çağırmak için
Dim adresANASAYFA As String
adresANASAYFA = "SELECT * FROM [ANA SAYFA] "
Set DataKayitlari = DataBaglan.OpenRecordset(adresANASAYFA, dbOpenSnapshot)
If DataKayitlari.NoMatch = True Then 'Nomatch özelliktir. Bu özellik kayıt bulduysa False gönderir. kayıt bulamadıysa True gönderir.
MsgBox "Eğitim ID numarasını kontrol ediniz, Eğitim bulunamadı! ", vbCritical, "Hata"
Else
Range("A2").CopyFromRecordset DataKayitlari
sonstr = Cells(Rows.Count, "C").End(xlUp).Row
DataKayitlari.Close
Set DataKayitlari = Nothing
DataBaglan.Close
Set DataBaglan = Nothing
For x = 2 To sonstr
If InStr(1, Range("c" & x), "<font color=red>") > 0 Then Range("c" & x).Font.Color = vbRed
Range("c" & x) = PlainText(Range("c" & x))
Next x
End If
End Sub
(22/08/2021, 23:10)berduş yazdı: aşağıdaki kodu dener misiniz?Teşekkürler berduş hocam yapacağım programda emeğiniz çok sağolun Veri Kaydetme ve Veri Güncelleme kodlarında da eklediğiniz kısmı eklersem kodlar çalışırmı acaba
Sub CommandButton1_Click()
' Vba Tools sekmesindeki "Referanslar bölümüne tıklayın"
' "Microsoft Office xx.0 Access database engine Object Library" alanını seçmeniz gereklidir.
Dim DataBaglan As DAO.Database
Dim DataKayitlari As DAO.Recordset
'
Set DataBaglan = OpenDatabase(ThisWorkbook.Path & "\ANA SAYFA.accdb", False, False, "MS Access;PWD=" & 1234) '<-- düzenlenen kısım
'Set DataBaglan = OpenDatabase("C:\Users\mert\Desktop\veri\ANA SAYFA.accdb")
'EgitimListesi tablosu içerisinde veri çağırmak için
Dim adresANASAYFA As String
adresANASAYFA = "SELECT * FROM [ANA SAYFA] "
Set DataKayitlari = DataBaglan.OpenRecordset(adresANASAYFA, dbOpenSnapshot)
If DataKayitlari.NoMatch = True Then 'Nomatch özelliktir. Bu özellik kayıt bulduysa False gönderir. kayıt bulamadıysa True gönderir.
MsgBox "Eğitim ID numarasını kontrol ediniz, Eğitim bulunamadı! ", vbCritical, "Hata"
Else
Range("A2").CopyFromRecordset DataKayitlari
sonstr = Cells(Rows.Count, "C").End(xlUp).Row
DataKayitlari.Close
Set DataKayitlari = Nothing
DataBaglan.Close
Set DataBaglan = Nothing
For x = 2 To sonstr
If InStr(1, Range("c" & x), "<font color=red>") > 0 Then Range("c" & x).Font.Color = vbRed
Range("c" & x) = PlainText(Range("c" & x))
Next x
End If
End Sub
bağlantı için referanslardan "Microsoft microsoft ActiveX Data Object xx.x Library" eklenirse aşağıdaki kod da kullanılabilir
Sub CommandButton1_Click()
' Vba Tools sekmesindeki "Referanslar bölümüne tıklayın"
' "Microsoft microsoft ActiveX Data Object xx.x Library" alanını seçmeniz gereklidir.
'hy_şifreli accessi Excele Bağla Referanslı _________________________________________________
Dim Sql As String
Dim ADO_RS As ADODB.Recordset
Dim ADO_CN As ADODB.Connection
SQL = "SELECT * FROM [ANA SAYFA] "
Set ADO_RS = New ADODB.Recordset
Set ADO_CN = New ADODB.Connection
ADO_CN.ConnectionString = "provider=Microsoft.ACE.OLEDB.12.0;" & _
"Data Source=" & ThisWorkbook.Path & "\ANA SAYFA.accdb;" & _
"Jet OLEDBatabase Password= 1234"
ADO_CN.Open
ADO_RS.Open SQL, ADO_CN, 3, 1
'
If ADO_RS.RecordCount < 1 Then 'Nomatch özelliktir. Bu özellik kayıt bulduysa False gönderir. kayıt bulamadıysa True gönderir.
MsgBox "Eğitim ID numarasını kontrol ediniz, Eğitim bulunamadı! ", vbCritical, "Hata"
Else
Range("A2").CopyFromRecordset ADO_RS
sonstr = Cells(Rows.Count, "C").End(xlUp).Row
For x = 2 To sonstr
If InStr(1, Range("c" & x), "<font color=red>") > 0 Then Range("c" & x).Font.Color = vbRed
Range("c" & x) = PlainText(Range("c" & x))
Next x
End If
ADO_RS.Close
ADO_CN.Close
Set ADO_RS = Nothing
Set ADO_CN = Nothing
End Sub
(22/08/2021, 23:16)mert_0671 yazdı: Veri Kaydetme ve Veri Güncelleme kodlarında da eklediğiniz kısmı eklersem kodlar çalışırmı acababu kısmı anlamadım?
(22/08/2021, 23:26)berduş yazdı: bağlantı için referanslardan "Microsoft microsoft ActiveX Data Object xx.x Library" eklenirse aşağıdaki kod da kullanılabilir
Sub CommandButton1_Click()
' Vba Tools sekmesindeki "Referanslar bölümüne tıklayın"
' "Microsoft microsoft ActiveX Data Object xx.x Library" alanını seçmeniz gereklidir.
'Excel Excel Bağla Referanslı _________________________________________________
Dim Sql As String
Dim ADO_RS As ADODB.Recordset
Dim ADO_CN As ADODB.Connection
SQL = "SELECT * FROM [ANA SAYFA] "
Set ADO_RS = New ADODB.Recordset
Set ADO_CN = New ADODB.Connection
ADO_CN.ConnectionString = "provider=Microsoft.ACE.OLEDB.12.0;" & _
"Data Source=" & ThisWorkbook.Path & "\ANA SAYFA.accdb;" & _
"Jet OLEDBatabase Password= 1234"
ADO_CN.Open
ADO_RS.Open SQL, ADO_CN, 3, 1
'
If ADO_RS.RecordCount < 1 Then 'Nomatch özelliktir. Bu özellik kayıt bulduysa False gönderir. kayıt bulamadıysa True gönderir.
MsgBox "Eğitim ID numarasını kontrol ediniz, Eğitim bulunamadı! ", vbCritical, "Hata"
Else
Range("A2").CopyFromRecordset ADO_RS
sonstr = Cells(Rows.Count, "C").End(xlUp).Row
For x = 2 To sonstr
If InStr(1, Range("c" & x), "<font color=red>") > 0 Then Range("c" & x).Font.Color = vbRed
Range("c" & x) = PlainText(Range("c" & x))
Next x
End If
ADO_RS.Close
ADO_CN.Close
Set ADO_RS = Nothing
Set ADO_CN = Nothing
End Sub
(22/08/2021, 23:16)mert_0671 yazdı: Veri Kaydetme ve Veri Güncelleme kodlarında da eklediğiniz kısmı eklersem kodlar çalışırmı acababu kısmı anlamadım?
Yani yazmış olduğunuz parola kısmını Access veri tabanına kayıt eklemekte ve güncellemede kullandığım makroların ilgili kısmına eklersem hata verirmi
bence vermemeli ama deneyin, sorun çıkarsa çözmeye çalışırız.
Konuyu Okuyanlar: 3 Ziyaretçi