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

[SNNAY]

Kod: Tümünü seç

Sub ADO_VeriKaydet()
    Dim cnn As Object
    Dim rst As Object
    Dim strSQL As String
    Dim FilePath As String
    Dim i As Integer
    Dim ws As Worksheet
    Dim LastRow As Long
    Dim veri As Variant

    ' Kapalı dosya yolu
    FilePath = "C:\Users\YourUsername\Desktop\KasaVeriYenilemeKayıtları.xlsx"
    
    ' DÖVİZ sayfasındaki veriyi al
    Set ws = ThisWorkbook.Sheets("DÖVİZ")
    veri = ws.Range("F3:H15").Value

    ' ADO bağlantısı
    Set cnn = CreateObject("ADODB.Connection")
    cnn.Open "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & FilePath & ";Extended Properties=""Excel 12.0 Xml;HDR=Yes;"";"
    
    ' Veriyi kaydetmek için SQL sorgusu oluştur
    strSQL = "INSERT INTO [VERİLER$] (F3, F4, F5, F6, F7, F8, F9, F10, F11, F12, F13, F14, F15) VALUES "
    
    ' Verileri SQL formatına çevir
    For i = LBound(veri, 1) To UBound(veri, 1)
        strSQL = strSQL & "("
        For j = LBound(veri, 2) To UBound(veri, 2)
            strSQL = strSQL & "'" & veri(i, j) & "',"
        Next j
        strSQL = Left(strSQL, Len(strSQL) - 1) & "),"
    Next i
    strSQL = Left(strSQL, Len(strSQL) - 1)
    
    ' Verileri kapalı dosyaya yaz
    cnn.Execute strSQL
    cnn.Close
    Set cnn = Nothing
    
    MsgBox "Veriler başarıyla kaydedildi!"
End Sub

Kod: Tümünü seç

Sub ADO_VeriCek()
    Dim cnn As Object
    Dim rst As Object
    Dim strSQL As String
    Dim FilePath As String
    Dim ws As Worksheet
    Dim i As Integer
    
    ' Kapalı dosya yolu
    FilePath = "C:\Users\YourUsername\Desktop\KasaVeriYenilemeKayıtları.xlsx"
    
    ' ADO bağlantısı
    Set cnn = CreateObject("ADODB.Connection")
    cnn.Open "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & FilePath & ";Extended Properties=""Excel 12.0 Xml;HDR=Yes;"";"
    
    ' Verileri seçmek için SQL sorgusu oluştur
    strSQL = "SELECT * FROM [VERİLER$]"
    
    ' Sorguyu çalıştır
    Set rst = CreateObject("ADODB.Recordset")
    rst.Open strSQL, cnn, 1, 3
    
    ' DÖVİZ sayfasına verileri yapıştır
    Set ws = ThisWorkbook.Sheets("DÖVİZ")
    ws.Range("F3").CopyFromRecordset rst
    
    rst.Close
    cnn.Close
    Set rst = Nothing
    Set cnn = Nothing
    
    MsgBox "Veriler başarıyla geri getirildi!"
End Sub

[Sinan05]

Kod: Tümünü seç

Sub ADO_VeriKaydet()
    Dim cnn As Object
    Dim rst As Object
    Dim strSQL As String
    Dim FilePath As String
    Dim i As Integer
    Dim ws As Worksheet
    Dim LastRow As Long
    Dim veri As Variant

    ' Kapalı dosya yolu
    FilePath = "C:\Users\YourUsername\Desktop\KasaVeriYenilemeKayıtları.xlsx"
    
    ' DÖVİZ sayfasındaki veriyi al
    Set ws = ThisWorkbook.Sheets("DÖVİZ")
    veri = ws.Range("F3:H15").Value

    ' ADO bağlantısı
    Set cnn = CreateObject("ADODB.Connection")
    cnn.Open "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & FilePath & ";Extended Properties=""Excel 12.0 Xml;HDR=Yes;"";"
    
    ' Veriyi kaydetmek için SQL sorgusu oluştur
    strSQL = "INSERT INTO [VERİLER$] (F3, F4, F5, F6, F7, F8, F9, F10, F11, F12, F13, F14, F15) VALUES "
    
    ' Verileri SQL formatına çevir
    For i = LBound(veri, 1) To UBound(veri, 1)
        strSQL = strSQL & "("
        For j = LBound(veri, 2) To UBound(veri, 2)
            strSQL = strSQL & "'" & veri(i, j) & "',"
        Next j
        strSQL = Left(strSQL, Len(strSQL) - 1) & "),"
    Next i
    strSQL = Left(strSQL, Len(strSQL) - 1)
    
    ' Verileri kapalı dosyaya yaz
    cnn.Execute strSQL
    cnn.Close
    Set cnn = Nothing
    
    MsgBox "Veriler başarıyla kaydedildi!"
End Sub

Kod: Tümünü seç

Sub ADO_VeriCek()
    Dim cnn As Object
    Dim rst As Object
    Dim strSQL As String
    Dim FilePath As String
    Dim ws As Worksheet
    Dim i As Integer
    
    ' Kapalı dosya yolu
    FilePath = "C:\Users\YourUsername\Desktop\KasaVeriYenilemeKayıtları.xlsx"
    
    ' ADO bağlantısı
    Set cnn = CreateObject("ADODB.Connection")
    cnn.Open "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & FilePath & ";Extended Properties=""Excel 12.0 Xml;HDR=Yes;"";"
    
    ' Verileri seçmek için SQL sorgusu oluştur
    strSQL = "SELECT * FROM [VERİLER$]"
    
    ' Sorguyu çalıştır
    Set rst = CreateObject("ADODB.Recordset")
    rst.Open strSQL, cnn, 1, 3
    
    ' DÖVİZ sayfasına verileri yapıştır
    Set ws = ThisWorkbook.Sheets("DÖVİZ")
    ws.Range("F3").CopyFromRecordset rst
    
    rst.Close
    cnn.Close
    Set rst = Nothing
    Set cnn = Nothing
    
    MsgBox "Veriler başarıyla geri getirildi!"
End Sub

Hocam teşekkürler dönüşünüz için. ADO_VeriKaydet makrosunu çalıştırdım cnn.Execute strSQL 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.

[SNNAY]

Diğer dosyalarda sorunsuz çalışan ADO makrolarınızı bu dosyada denediğinizde eğer çalışıyorsa, VBA ayarlarıyla ilgili büyük bir problem yoktur. Ancak, birleşik hücrelerle çalışırken ADO hata verebilir. Birleşik hücreler ADO işlemlerini zorlaştırabilir. Bu yüzden, mümkünse birleşik hücreleri ayırarak işlem yapmalısınız. Eğer birleşik hücreleri ayıramıyorsanız, verilerin sadece rakam içeren hücrelerle çalışmasını sağlamak iyi bir çözüm olabilir.
SQL Sorgusu: Birleşik hücreler ve veri tipi uyuşmazlıkları (örneğin, metin yerine sayı veya tarih) bu tür hatalara neden olabilir. Basit bir sorgu ile test ederseniz, sorunun birleşik hücrelerden mi yoksa veri formatından mı kaynaklandığını anlayabilirsiniz.
Veritabanı Hücre Yapısı: Kapalı dosyadaki hücrelerin de doğru biçimde yapılandırıldığından emin olun. Özellikle, veri kaydederken tablo başlıkları (1. satırdaki başlıklar) ve veri alanlarının doğru şekilde tanımlandığına dikkat edin.

[Sinan05]

Diğer dosyalarda sorunsuz çalışan ADO makrolarınızı bu dosyada denediğinizde eğer çalışıyorsa, VBA ayarlarıyla ilgili büyük bir problem yoktur. Ancak, birleşik hücrelerle çalışırken ADO hata verebilir. Birleşik hücreler ADO işlemlerini zorlaştırabilir. Bu yüzden, mümkünse birleşik hücreleri ayırarak işlem yapmalısınız. Eğer birleşik hücreleri ayıramıyorsanız, verilerin sadece rakam içeren hücrelerle çalışmasını sağlamak iyi bir çözüm olabilir.
SQL Sorgusu: Birleşik hücreler ve veri tipi uyuşmazlıkları (örneğin, metin yerine sayı veya tarih) bu tür hatalara neden olabilir. Basit bir sorgu ile test ederseniz, sorunun birleşik hücrelerden mi yoksa veri formatından mı kaynaklandığını anlayabilirsiniz.
Veritabanı Hücre Yapısı: Kapalı dosyadaki hücrelerin de doğru biçimde yapılandırıldığından emin olun. Özellikle, veri kaydederken tablo başlıkları (1. satırdaki başlıklar) ve veri alanlarının doğru şekilde tanımlandığına dikkat edin.

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ı.

[SNNAY]

ADO SQL ile veri kaydetmek için belirli hücrelerdeki verileri kullanırken, sayfalardaki isimlerin farklı olmasının sorun oluşturmadığı doğru. Ancak, ADO işlemlerini gerçekleştirmek için bazı ayarların ve doğru hücre referanslarının sağlanması gereklidir. DÖVİZ sayfasından aldığınız verileri VERİLER2 sayfasına yatay olarak kaydetmek istediğinizde, bu işlem için SQL sorgusunun doğru yapılandırılması önemlidir.

DÖVİZ Sayfasından Veri Alma ve Yatay Olarak YapıştırmaK için;

Kod: Tümünü seç

 Sub VeriAlVeYatayYapistir()
    Dim wsDoviz As Worksheet
    Dim wsVeriler2 As Worksheet
    Dim i As Long
    Dim SonSatir As Long
    Dim Rakamlar As Variant

    Set wsDoviz = ThisWorkbook.Sheets("DÖVİZ")
    Set wsVeriler2 = ThisWorkbook.Sheets("VERİLER2")

    ' DÖVİZ sayfasındaki F3:F15 arası verileri al
    Rakamlar = Application.Transpose(wsDoviz.Range("F3:F15").Value)

    ' VERİLER2 sayfasındaki boş ilk satırı bul
    SonSatir = wsVeriler2.Cells(wsVeriler2.Rows.Count, 1).End(xlUp).Row + 1

    ' Verileri yatay olarak yapıştır
    wsVeriler2.Cells(SonSatir, 1).Resize(1, UBound(Rakamlar)).Value = Rakamlar
End Sub

ADO ile KasaVeriYenilemeKayıtları Dosyasına Kaydetmek için;

Kod: Tümünü seç

Sub ADO_VeriKaydet()
    Dim cnn As Object
    Dim strSQL As String
    Dim FilePath As String
    Dim ws As Worksheet
    Dim Rakamlar As Variant
    Dim SonSatir As Long
    Dim i As Long

    ' Kapalı dosya yolu
    FilePath = "C:\Users\YourUsername\Desktop\KasaVeriYenilemeKayıtları.xlsx"
    
    ' VERİLER2 sayfasındaki veriyi al
    Set ws = ThisWorkbook.Sheets("VERİLER2")
    SonSatir = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row ' Son satırı bul

    ' Rakamlar dizisi
    Rakamlar = ws.Range(ws.Cells(SonSatir, 1), ws.Cells(SonSatir, ws.Columns.Count)).Value
    
    ' ADO bağlantısı
    Set cnn = CreateObject("ADODB.Connection")
    cnn.Open "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & FilePath & ";Extended Properties=""Excel 12.0 Xml;HDR=Yes;"";"
    
    ' SQL sorgusu
    strSQL = "INSERT INTO [VERİLER2$](A, B, C, D, E, F, G, H, I, J, K, L, M, N, O) VALUES ("

    For i = 1 To UBound(Rakamlar, 2)
        strSQL = strSQL & "'" & Rakamlar(1, i) & "'"
        If i < UBound(Rakamlar, 2) Then strSQL = strSQL & ", "
    Next i
    
    strSQL = strSQL & ")"

    ' Veriyi kapalı dosyaya yaz
    cnn.Execute strSQL
    cnn.Close
    Set cnn = Nothing
    
    MsgBox "Veriler başarıyla kaydedildi!"
End Sub

Eğer DÖVİZ sayfasında birleşik hücreler varsa ve bunları ayırmak istemiyorsan, UnMerge işlemi yapmadan yukarıdaki VeriAlVeYatayYapistir makrosunu kullanarak doğrudan verileri alabilirsin.

KasaVeriYenilemeKayıtları dosyasındaki VERİLER2 sayfasında A, B, C, ..., O hücrelerini kullanarak veri kaydediyoruz. Burada, Rakamlar dizisinin boyutuna göre sorguyu dinamik olarak oluşturuyoruz.

Dosya Yolu: Kendi dosya yolunuzu FilePath değişkenine uygun şekilde ayarlayın.

Veri Formatı: SQL sorgusunda metin verileri için tek tırnak içinde (') yazılmasına dikkat edin. Rakamlar için bu işlem gerekmez. Ancak, eğer tarih veya özel bir format varsa, bunları uygun şekilde ayarlamanız gerekecek

[Sinan05]

Hocam sağolun ama bende kapalaı dosyaya veri yazıp çeken makro var. ilaveten ado düşündüm. lakin sanırım istediğim gibi olmayacak. dosya yulu, kullanıcı profili ve sayfa ismi doğru olmasına rağmen Set ws = ThisWorkbook.Sheets("VERİLER2") bu kodda yine hata veriyor.