öncelikle referanslardan Microsoft ActiveX data objects xx library eklenmeli
sonra yeni bir modül eklenip modüle aşağıdaki fonksiyon tanımlanmalı
Sub AccessAl(SyfAdiDz() As Variant)
Dim AdoCon As ADODB.Connection
Dim AdoRs As ADODB.Recordset
Dim AdoSql As String
VTAdi = ThisWorkbook.Path & "\YILDIZ_VeriTabanı.accdb"
Set AdoCon = New ADODB.Connection
AdoConString = "Provider=Microsoft.ACE.OLEDB.12.0;" & "Data Source=" & VTAdi
AdoCon.Open AdoConString
Dim Sht As Worksheet
Dim SonStn As Long
Dim SyfAdi As Variant
For Each SyfAdi In SyfAdiDz
Set AdoRs = New ADODB.Recordset
AdoSql = "Select * from " & SyfAdi '& " order by [F1];"
Set Sht = ThisWorkbook.Worksheets(SyfAdi)
SonStn = Sht.Cells(1, Sht.Columns.Count).End(xlToLeft).Column
SonStr = Sht.Cells(Sht.Rows.Count, 1).End(3).Column
xhrf = Split(Cells(1, SonStn).Address, "$")(1)
Sht.Range("A2:" & xhrf & Sht.Rows.Count).Clear ' .Cells(2, SonStn).Clear
Set AdoRs = AdoCon.Execute(AdoSql)
Sht.Range("A2").CopyFromRecordset AdoRs
AdoRs.Close
Next
AdoCon.Close
Set AdoRs = Nothing
Set AdoCon = Nothing
End Sub
excele alma butonunun kodu da aşağıdaki gibi olmalı
Dim SyfAdiDz() As Variant
SyfAdi = 0
For i = 0 To ListBox1.ListCount - 1
If ListBox1.Selected(i) Then
ReDim Preserve SyfAdiDz(SyfAdi)
SyfAdiDz(SyfAdi) = ListBox1.List(i)
SyfAdi = SyfAdi + 1
End If
Next i
Dim Name As Variant
For Each Name In SyfAdiDz
Debug.Print Name
Next
AccessAl SyfAdiDz()
MsgBox "aktarım tamam"
henüz accesse aktarma kısmındaki boş kayıtları silme kodu eklenmemiştir
o nedenle tabloda boş kayıtlar olabilir
NET İŞLEMLERİ_hy4.rar
(Dosya Boyutu: 758,54 KB | İndirme Sayısı: 3)
