ADO ile Kayıt

[steppe]

Merhaba Arkadaşlar,
Bu forum sayfasından bulduğum ADO ile excel'den access'e kayıt yapma örneğini paylaşmak istedim.Ayrıca epeyce araştırmama rağmen bulamadığım sorunu da sormak istedim.
Excel deki bilgiler access'e gayet güzel kaydediliyor.Yalnız kayıt yaparken bir alanda özel yapıştırı yapamadım.
Excel de E sütunundaki telefonları accesse aktarırken nasıl özel yapıştır yapabilirim?
Not: Excel de E sütunundaki telefonlar normalde 2354647 formatında, hücre biçimlendirme yoluyla 0242 235 46 47 şekline dönüşüyor. Accesse kopyalarken 2354647 şeklinde atıyor.Halbuki ben oldukça fazla veri olduğu için 0242 235 46 47 formatındaki haliyle (Paste Special) şeklinde atmak istiyorum.
Yardımlarınız için şimdiden teşekkür ederim.

 

[Korhan Ayhan]

Merhaba,

Dosyanızı paylaştığınız bölüm örnek uygulamaların olduğu bölümdür. onay dahilinde konu açılabiliyor.

Konunuzu makrolar bölümüne taşıdım.

Aşağıdaki kod ile sanırım sonuca gidebilirsiniz.

Ben ofis 2016 kullandığım için bağlantı kodu değiştirmek durumunda kaldım. Siz pasif satırı aktif hale getirip denersiniz.

Access dosyasında tablo adını ve tarih sütunu başlığını değiştirdim. Siz kendinize göre uyarlarsınız.

Private Sub CommandButton1_Click()
    Dim cn As ADODB.Connection, rs As ADODB.Recordset, r As Long, t As Double
    
    t = Timer
    Set cn = New ADODB.Connection
    
    'cn.Open "Provider=Microsoft.Jet.OLEDB.4.0; " & _
        "Data Source=" & ThisWorkbook.Path & "\Ado.mdb;"
    
    cn.Open "Provider=Microsoft.ACE.OLEDB.12.0; " & _
        "Data Source=" & ThisWorkbook.Path & "\Ado.mdb;"

    Set rs = New ADODB.Recordset
    rs.Open "Tablo1", cn, adOpenKeyset, adLockOptimistic, adCmdTable
   
    r = 2
    Do While Len(Range("A" & r).Formula) > 0

        With rs
            .AddNew
            .Fields("TARİH") = Range("A" & r).Value
            .Fields("AD") = Range("B" & r).Value
            .Fields("SOYAD") = Range("C" & r).Value
            .Fields("ADRES") = Range("D" & r).Value
            .Fields("TELEFON") = "0242 " & Format(Range("E" & r).Value, "### ## ##")
            .Update
        End With
        r = r + 1
    Loop
    
    rs.Close
    Set rs = Nothing
    cn.Close
    Set cn = Nothing
    
    MsgBox "Veriler aktarılmıştır. İşlem süresi ; " & Format(Timer - t, "0.000")
End Sub

 

[steppe]

Korhan Hocam,
Yardımlarınız için çok teşekkür ederim.