Özel Arama
Şifresiz accdb veritabanına veri girişi yaptığım bir excel kitabını şifreli mdb'ye veri aktaracak şekilde düzenlemek istedim.
Makroyu çalıştırdığımda "yüklenebilir ISAM bulunamadı" hatası alıyorum.
Debug beni şu satıra götürüyor ;
- Kod: Tümünü seç
evn.Open "provider=Microsoft.ACE.OLEDB.12.0;data source= & dosya;Jet OLEDB: Database Password ='Adacolor2014*/';"
sub kodlarının tamamı şu şekilde ;
Kod:
- Kod: Tümünü seç
Sub veritabaninakayit()
Dim evn As Object, rs As Object
Dim s1 As Worksheet
Dim oran1 As Double, oran2 As Double, oran3 As Double, oran4 As Double, oran5 As Double
Set evn = CreateObject("adodb.connection")
dosya = ThisWorkbook.Path & "\ADAveri.mdb"
evn.Open "provider=Microsoft.ACE.OLEDB.12.0;data source= & dosya;Jet OLEDB: Database Password ='Adacolor2014*/';"
Set rs = CreateObject("adodb.recordset")
rs.Open "select * from formulcolibri", evn, 1, 3
Set Sht = ThisWorkbook.Worksheets("formcek")
Set s1 = Sheets("formcek")
SonStr = Sht.Cells(Sht.Rows.Count, "B").End(xlUp).Row
sayac = 0
xy = 6
yx = 6
For x = 2 To SonStr
oran1 = s1.Range("F" & x).Text
oran2 = s1.Range("H" & x).Text
oran3 = s1.Range("J" & x).Text
oran4 = s1.Range("L" & x).Text
oran5 = s1.Range("N" & x)
rs.addnew
rs.Fields("Formul").Value = s1.Range("B" & x).Value
rs.Fields("Tanim").Value = s1.Range("C" & x).Value
rs.Fields("Seri").Value = s1.Range("D" & x).Value
rs.Fields("K1").Value = s1.Range("E" & x).Value
rs.Fields("O1").Value = oran1
rs.Fields("K2").Value = s1.Range("G" & x).Value
rs.Fields("O2").Value = oran2
rs.Fields("K3").Value = s1.Range("I" & x).Value
rs.Fields("O3").Value = oran3
rs.Fields("K4").Value = s1.Range("K" & x).Value
rs.Fields("O4").Value = oran4
rs.Fields("K5").Value = s1.Range("M" & x).Value
rs.Fields("O5").Value = oran5
rs.Fields("K6").Value = s1.Range("O" & x).Value
rs.Fields("O6").Value = s1.Range("P" & x).Value
rs.Fields("K7").Value = s1.Range("R" & x).Value
rs.Fields("O7").Value = s1.Range("S" & x).Value
rs.Fields("K8").Value = s1.Range("T" & x).Value
rs.Fields("O8").Value = s1.Range("U" & x).Value
rs.Fields("K9").Value = s1.Range("V" & x).Value
rs.Fields("O9").Value = s1.Range("W" & x).Value
rs.Fields("K10").Value = s1.Range("X" & x).Value
rs.Fields("O10").Value = s1.Range("Y" & x).Value
sayac = sayac + 1
xy = xy + 2
yx = yx + 2
Next x
rs.Update
rs.Close: Set rs = Nothing
evn.Close: Set evn = Nothing
For x = 2 To SonStr
s1.Range("B" & x, "Z" & x).ClearContents
Next x
MsgBox (sayac & "-" & "Adet Recete Aktarildi")
Sayfa1.Range("A:A").ClearContents
End Sub
Nerede hata yapıyorum?
Teşekkürler.
