Excelden Accesse Veri Alıp Gönderme

(14/02/2021, 23:48)hayalibey yazdı: Peki accessten Excel e de aktarma yapıyor mu.

(14/02/2021, 23:58)feraz yazdı:

(14/02/2021, 23:48)hayalibey yazdı: Peki accessten Excel e de aktarma yapıyor mu.

O kısma bakmadım abey Aynı yöntemin tersini uygulanabilir bence.Halil hocamız el atar onada.
Benim fazla zamanım olmuyor bu aralar.

(14/02/2021, 23:01)feraz yazdı: objAccess.DoCmd.DeleteObject acTable, SyfAdi

(15/02/2021, 00:13)feraz yazdı:

(14/02/2021, 23:01)feraz yazdı: objAccess.DoCmd.DeleteObject acTable, SyfAdi

Tamam abey.Zaten yukardaki kod accessteki tabloyu silip diğer kodlada sayfayı tüm tablo olarak aktarıyor tabii acceste varsa aynı tablo isminde.Yani hata olmaz bence.Accessten excele aktarırkende accessteki tablo excelde varsa sayfa temizlenip  tablo aktarılır kodla.Ya Ado yada accessteki docmd kodu ile tümden aktarılır.Heralde accesste docmd ile export ediyordur.Olmazsa bile ado ilede kolayca aktarılır select yöntemi ile.Yani bence zor olmaz.Berduş hocamız çok pratik kodlar yazıyor bizde faydalanıyoruz Zafer Hocam veritabanında seçilen sayfalar bulunamadı hatası veriyor

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

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"