Kapalı Dosyaya Veri Alış-Verişi...!!!

[sinan05]

Merhabalar. Aşağıya eklediğim makro ile dosyamda, dış bağlantı ile güncellenmiş verilerimi DÖVİZ sayfasından dikey olarak kopyalayıp VERİLER sayfasına devrik dönşüm ile yatay olarak kaydediyorum başka bir makro ile de tarihe göre sorgulayıp DÖVİZ sayfasına devrik dönüşüm ile dikey olarak getiriyorum. Sorunum, çok fazla verinin dosyamda birikmesini istemiyorum, buna istinaden verileri ADO SQL ile masa üstünde bulunan KasaVeriYenilemeKayıtları adlı kapalı dosyaya kaydedip yine bu kapalı dosyadan verileri çekmek istiyorum. Yardımlarınız ve ilgi alakanız için şimdiden teşekkürler.

Sub VERİLER()
Application.ScreenUpdating = False
Sheets("DÖVİZ").Select
Range("F3:H15").Select
Selection.Copy
Sheets("VERİLER").Select
Range("B2").End(xlDown).Offset(1, 0).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=True
Selection.End(xlToLeft) = Date
Selection.End(xlToRight).Offset(0, 1).Value = Format(Now, "hh:mm")
Application.CutCopyMode = False
Application.ScreenUpdating = True
ThisWorkbook.Sheets("DÖVİZ").Select
Range("A1").Select
End Sub

 

[pitchoute]

Merhabalar, deneyip sonucu paylaşabilir misiniz;

Verileri kapalı dosyaya yazmak için şunu kullanın;

Sub VerileriKapaliDosyayaYaz()
    Dim cn As ADODB.Connection
    Dim cmd As ADODB.Command
    Dim strSQL As String
    Dim i As Integer
    Dim sValues As String
    Dim DosyaYolu As String
    Dim rng As Range
    Dim ws As Worksheet
    
    Application.ScreenUpdating = False

    Set ws = ThisWorkbook.Sheets("DÖVİZ")
    Set rng = ws.Range("F3:H15")

    DosyaYolu = Environ("USERPROFILE") & "\Desktop\KasaVeriYenilemeKayıtları.xlsx"

    Set cn = New ADODB.Connection
    With cn
        .Provider = "Microsoft.ACE.OLEDB.12.0"
        .ConnectionString = "Data Source=" & DosyaYolu & ";" & _
                            "Extended Properties=""Excel 12.0 Xml;HDR=Yes;IMEX=0"";"
        .Open
    End With

    For i = 1 To rng.Rows.Count
        sValues = ""
        sValues = "'" & rng.Cells(i, 1).Value & "','" & rng.Cells(i, 2).Value & "','" & rng.Cells(i, 3).Value & "',#" & Format(Date, "yyyy/mm/dd") & "#,'" & Format(Time, "hh:mm:ss") & "'"
        strSQL = "INSERT INTO [VERİLER$] ([Kolon1], [Kolon2], [Kolon3], [Tarih], [Saat]) VALUES (" & sValues & ")"
        cn.Execute strSQL
    Next i

    cn.Close
    Set cn = Nothing

    Application.ScreenUpdating = True
    MsgBox "Veriler kapalı dosyaya başarıyla kaydedildi.", vbInformation
End Sub

Kapalı dosyadan verileri okumak için şunu kullanın;

Sub KapaliDosyadanVeriOku()
    Dim cn As ADODB.Connection
    Dim rs As ADODB.Recordset
    Dim strSQL As String
    Dim DosyaYolu As String
    Dim ws As Worksheet

    Application.ScreenUpdating = False

    DosyaYolu = Environ("USERPROFILE") & "\Desktop\KasaVeriYenilemeKayıtları.xlsx"

    Set cn = New ADODB.Connection
    With cn
        .Provider = "Microsoft.ACE.OLEDB.12.0"
        .ConnectionString = "Data Source=" & DosyaYolu & ";" & _
                            "Extended Properties=""Excel 12.0 Xml;HDR=Yes;IMEX=1"";"
        .Open
    End With

    strSQL = "SELECT * FROM [VERİLER$]"

    Set rs = New ADODB.Recordset
    rs.Open strSQL, cn, adOpenStatic, adLockReadOnly

    Set ws = ThisWorkbook.Sheets("DÖVİZ")
    ws.Range("A1").CopyFromRecordset rs

    rs.Close
    cn.Close
    Set rs = Nothing
    Set cn = Nothing

    Application.ScreenUpdating = True
    MsgBox "Veriler kapalı dosyadan başarıyla alındı.", vbInformation
End Sub

 

[sinan05]

Merhabalar, deneyip sonucu paylaşabilir misiniz;

Verileri kapalı dosyaya yazmak için şunu kullanın;

Sub VerileriKapaliDosyayaYaz()
    Dim cn As ADODB.Connection
    Dim cmd As ADODB.Command
    Dim strSQL As String
    Dim i As Integer
    Dim sValues As String
    Dim DosyaYolu As String
    Dim rng As Range
    Dim ws As Worksheet

    Application.ScreenUpdating = False

    Set ws = ThisWorkbook.Sheets("DÖVİZ")
    Set rng = ws.Range("F3:H15")

    DosyaYolu = Environ("USERPROFILE") & "\Desktop\KasaVeriYenilemeKayıtları.xlsx"

    Set cn = New ADODB.Connection
    With cn
        .Provider = "Microsoft.ACE.OLEDB.12.0"
        .ConnectionString = "Data Source=" & DosyaYolu & ";" & _
                            "Extended Properties=""Excel 12.0 Xml;HDR=Yes;IMEX=0"";"
        .Open
    End With

    For i = 1 To rng.Rows.Count
        sValues = ""
        sValues = "'" & rng.Cells(i, 1).Value & "','" & rng.Cells(i, 2).Value & "','" & rng.Cells(i, 3).Value & "',#" & Format(Date, "yyyy/mm/dd") & "#,'" & Format(Time, "hh:mm:ss") & "'"
        strSQL = "INSERT INTO [VERİLER$] ([Kolon1], [Kolon2], [Kolon3], [Tarih], [Saat]) VALUES (" & sValues & ")"
        cn.Execute strSQL
    Next i

    cn.Close
    Set cn = Nothing

    Application.ScreenUpdating = True
    MsgBox "Veriler kapalı dosyaya başarıyla kaydedildi.", vbInformation
End Sub

Kapalı dosyadan verileri okumak için şunu kullanın;

Sub KapaliDosyadanVeriOku()
    Dim cn As ADODB.Connection
    Dim rs As ADODB.Recordset
    Dim strSQL As String
    Dim DosyaYolu As String
    Dim ws As Worksheet

    Application.ScreenUpdating = False

    DosyaYolu = Environ("USERPROFILE") & "\Desktop\KasaVeriYenilemeKayıtları.xlsx"

    Set cn = New ADODB.Connection
    With cn
        .Provider = "Microsoft.ACE.OLEDB.12.0"
        .ConnectionString = "Data Source=" & DosyaYolu & ";" & _
                            "Extended Properties=""Excel 12.0 Xml;HDR=Yes;IMEX=1"";"
        .Open
    End With

    strSQL = "SELECT * FROM [VERİLER$]"

    Set rs = New ADODB.Recordset
    rs.Open strSQL, cn, adOpenStatic, adLockReadOnly

    Set ws = ThisWorkbook.Sheets("DÖVİZ")
    ws.Range("A1").CopyFromRecordset rs

    rs.Close
    cn.Close
    Set rs = Nothing
    Set cn = Nothing

    Application.ScreenUpdating = True
    MsgBox "Veriler kapalı dosyadan başarıyla alındı.", vbInformation
End Sub

Hocam çok teşekkürler dönüşünüz için. ilk makroda şu kod cn.Execute strSQL hata verdi. Sonra dosya yolunda kullanıcı profilini sinan yaptım. bu sefer .Open kodu hata verdi. bende, başka dosyamda bir ADO SQL ile çalışan sorunsuz makrolarım var. Acaba bu dosyada VBA ayarlarında yapmam gereken bir şey mi var. Birde DÖVİZ sayfasındaki F sütununda F3:F15 arası birleşik gidiyor. Yani, F3 = F3-G3-H3 BİRLEŞİMİ, F4 = F4-G4-H4 BİRLEŞİMİ VS... F15 e kadar böyle ilk 2 satırında birleşik hücreler var ve ilk iki satır isimlerden oluşuyor. Sonraki satırlarda rakamlar var. . Bu makroyu etkliermi bilmiyorum. Verilerin çekileceği KasaVeriYenilemeKayıtları dosyasındaki sayfanın ismi VERİLER2 (BEN YAZDIĞINIZ MAKRODA DEĞİŞTİRDİM). VERİLER2 sayfasının ilk satırında A-O arası birleşik ve bu hücrede isim var. 2. satır ve sonrasında bileşik hücre yok.2.satırdaki A-O arası hücrelerde isim var. 3. satır hücrelerde ve sonrasında rakamlar var.

Not: Biraz daha detaylandırmak gerekirse; Hocam ben DÖVİZ sayfasındaki dikey verileri alıp VERİLER2 sayfasına yatay olarak kaydediyorum. Veri çekerkende tersi olarak yatay alıp dikeye döndürüyorum. Şimdi DÖVİZ ve VERİLER2 sayfalarının ilk iki satırında da isimler var ama iki sayfada da bu isimler farklı. Her iki sayfanın 3.satırları ve sonrası rakamlar var. DÖVİZ sayfasının F3:H15 (Birleşmemiş hali F3:F15) arasında bulunan rakamları kopyalayıp, VERİLER2 sayfasının 3.satırından aşağı doğru boş bulduğu ilk hücreye yatay olarak yapıştırıyorum. Buna göre her sütun başındaki isimler farklı oluyor. Bu yüzden benim sistemimde ado sql kaydı olmaz mı.