SQL sorguyu farklı bir dosyaya aktarmak

[tamer42]

Merhaba,

Aşağıdaki kod ile "Text" sayfasındaki sorgu sonucundaki verileri; aynı dosya içindeki "Rapor" sayfasına aktarılmakta;

burada sorgu socundaki verileri bu dosya ile aynı klasör altındaki Data.xlsx adındaki dosyanın "Rapor" adındaki sayfasına aktarmak için nasıl bir düzenleme yapılabilir?

desteğiniz için şimdiden teşekkürler,
iyi akşamalar.

Private Sub queryy()
Dim SH As Worksheet
Dim Conn As Object
Dim RS As Object
Dim sorgu As String

Set SH = Sheets("Rapor")
SH.Cells.ClearContents
yol = ThisWorkbook.FullName
Set Conn = VBA.CreateObject("adodb.Connection")

Conn.Open "provider=microsoft.ace.oledb.12.0;data source=" & _
yol & ";extended properties=""Excel 12.0;hdr=No"""

sorgu = "Select * From [Text$]" & _
" Where [F16] is not null "

Set RS = Conn.Execute(sorgu)

SH.Cells(1, 1).CopyFromRecordset RS

Conn.Close

Set Conn = Nothing
Set RS = Nothing

End Sub

 

[Korhan Ayhan]

Deneyiniz.

Private Sub queryy()
    Dim SH As Worksheet
    Dim Conn As Object
    Dim RS As Object
    Dim sorgu As String
    
    Set SH = Sheets("Rapor")
    SH.Cells.ClearContents
    Yol = ThisWorkbook.FullName
    Set Conn = VBA.CreateObject("adodb.Connection")
    
    Conn.Open "Provider=Microsoft.Ace.OleDb.12.0;Data Source=" & _
    Yol & ";Extended Properties=""Excel 12.0;Hdr=No"""
    
    sorgu = "Select * From [Text$]" & _
    " Where [F16] is not null "
    
    Set RS = Conn.Execute(sorgu)
    
    Set XL_App = CreateObject("Excel.Application")
    XL_App.Visible = False
    XL_App.Application.EnableEvents = False
    Set XL_Wb = XL_App.Workbooks.Open(Yol & "Data.xlsx")
    Set XL_Ws = XL_Wb.Worksheets("Rapor")
    
    XL_Ws.Cells.Clear
    XL_Ws.Cells(1, 1).CopyFromRecordset RS
    XL_Ws.Columns.AutoFit
        
    Conn.Close
    
    XL_Wb.Close True
    XL_App.Quit
    
    Set XL_Ws = Nothing
    Set XL_Wb = Nothing
    Set XL_App = Nothing
    Set Conn = Nothing
    Set RS = Nothing
End Sub

 

[haliliyas]

sayfa yapıları uygunsa doğrudan INSERT sorgusu da kullanılabilir
bu yöntemde dikkat edilmesi gereken nokta kapalı dosyaya veri eklenip silinmiş olsa bile o satırlar gerçek anlamda silinmemişse yeni verileri bu boş satırların altına ekliyor

Sub Ekle_ADO()
Dim Conn As Object
Dim sorgu As String

yol = ThisWorkbook.FullName
DosyaYolu = "[Excel 12.0 Xml;HDR=No;IMEX=0;DATABASE=" & ThisWorkbook.Path & "\Data.xlsm].[Rapor$]"

 Set Conn = VBA.CreateObject("adodb.Connection")
With Conn
        .Open " provider=microsoft.ace.oledb.12.0;data source=" & yol & _
                  " ;extended properties=""Excel 12.0;hdr=No"""
    sorgu = " INSERT INTO " & DosyaYolu & " ( [Alan1], [alan2] )" & _
            " SELECT T.[Alan1], T.[alan2]" & _
            " FROM [Text$] as T  where T.[F16] is not null;"
        .Execute (sorgu)
        .Close
End With
Set Conn = Nothing

End Sub

 

[tamer42]

Korhan& Halil hocam çok teşekkürler,

 

[haliliyas]

rica ederim
iyi çalışmalar
kodu deneme imkanınız oldu mu?
sorun çıktı mı?

 

[tamer42]

rica ederim
iyi çalışmalar
kodu deneme imkanınız oldu mu?
sorun çıktı mı?

Halil Hocam sizin kodu henüz deneme imkanım olmadı,
şunu soracağım
Ana dosyada yer alan tüm alanları aktaracağım
aşağıdaki sorguyu nasıl nasıl düzenleyebiliriz?
teşekkürler,

 sorgu = " INSERT INTO " & DosyaYolu & " ( [Alan1], [alan2] )" & _
            " SELECT T.[Alan1], T.[alan2]" & _
            " FROM [Text$] as T  where T.[F16] is not null;"

 

[haliliyas]

sorgu = " INSERT INTO " & DosyaYolu & _
        " SELECT T.* " & _
        " FROM [Text$] as T  where T.[F16] is not null;"

şeklinde olabilir.
not : bu kodlar her 2 sayfadaki yapının birebir aynı olduğu varsayımına dayanıyor, farklılıklar için ince ayar gerekebilir.
eğer alan adları uyumsuzsa mecburen tüm alan adları yazılmalı

 

[tamer42]

sorgu = " INSERT INTO " & DosyaYolu & _
        " SELECT T.* " & _
        " FROM [Text$] as T  where T.[F16] is not null;"

şeklinde olabilir.
not : bu kodlar her 2 sayfadaki yapının birebir aynı olduğu varsayımına dayanıyor, farklılıklar için ince ayar gerekebilir.
eğer alan adları uyumsuzsa mecburen tüm alan adları yazılmalı

Halil Hocam teşekkürler,
Alan adı yok zaten, "HDR=No" olarak ilerleyecek...

DELETE FROM Rapor

ile önceki verileri silebiliriz değil mi? çünkü her seferinde sıfırdan yüklemeye başlayacak
iyi çalışmalar.

 

[haliliyas]

hayır silemezsiniz
maalesef excel delete kodunu desteklemiyor

 

[Haluk]

"UPDATE" komutu bu işe daha uygun görünüyor...

.

 

[tamer42]

"UPDATE" komutu bu işe daha uygun görünüyor...

.

Haluk Hocam UPDATE komutunu burada nasıl uygulayabiliriz?
yönlendirebilirseniz sevinirim.
desteğiniz için şimdiden teşekkür

 

[haliliyas]

dosyanızı eklerseniz yardımcı olmaya çalışırız ama update komutu için 2 tablo arasında ilişki kurmamızı sağlayacak benzersiz alan gereklidir.
eğer dosyanızda benzersiz alan varsa önce update sorgusu çalıştırılıp veriler güncellenir sonrada insert sorgusu ile diğer tabloda olmayan veriler eklenebilir.
Not: altın üye olmadığımdan siteye yüklenecek dosyaları incelemem mümkün değil, o nedenle harici bir siteye yüklemeniz tercihimdir

 

[tamer42]

dosyanızı eklerseniz yardımcı olmaya çalışırız ama update komutu için 2 tablo arasında ilişki kurmamızı sağlayacak benzersiz alan gereklidir.
eğer dosyanızda benzersiz alan varsa önce update sorgusu çalıştırılıp veriler güncellenir sonrada insert sorgusu ile diğer tabloda olmayan veriler eklenebilir.
Not: altın üye olmadığımdan siteye yüklenecek dosyaları incelemem mümkün değil, o nedenle harici bir siteye yüklemeniz tercihimdir

Halil Hocam Kaynak dosya aşağıdaki linktedir.
Data isimli dosya ise buradaki "Rapor" sayfası olacak

https://dosya.co/bpxn37uohjz8/Kitap8.xlsb.html

teşekkürler, iyi günler.

 

[Haluk]

"Data.xlsx" dosyasında "Rapor" sayfasından başka kullanılan bir sayfa var mı ?

Not: Aslında yukarıda 2 No'lu mesajda Korhan Beyin kodu sizin isteğinizi karşılıyor.

.

 

[tamer42]

"Data.xlsx" dosyasında "Rapor" sayfasından başka kullanılan bir sayfa var mı ?

Not: Aslında yukarıda 2 No'lu mesajda Korhan Beyin kodu sizin isteğinizi karşılıyor.

.

Haluk Hocam
Data dosyasında başka bir sayfa bulunmuyor.
Korhan Hocamın kodları işimi görüyor, yalnız Hedef dosyayı açmadan da yapabilir miyiz?
teşekkürler, iyi günler.

 

[haliliyas]

eklediğiniz dosyada benzersiz alan yok dolayısıyla güncelleme/update sorgusunu doğrudan kullanamayız
eğer bu 15 alanın bileşimleri benzersizse olabilir. bu 15 alanın bileşimi benzersiz mi?
ama eklenecek veri çok fazla değilse @Korhan Ayhan hocamın kodu işinizi fazlasıyla görür
ADO ile kapalı dosyaya veri eklemeyi önermemin nedeni hedef dosyada veriler/makrolar çoksa dosyanın açılmasının zaman almasıdır.
ama burada olan önce hedefteki verilerin silinip sonra eklenmesi.
benzersiz alan varsa, güncelleme ve sonrasında ekleme kısmen işe yarayabilir. ama excel silme işlemini desteklemediği için silinmesi gerekenler tam olarak silinemez 2. bir update ile boş değer atanabilir sadece.

 

[tamer42]

eklediğiniz dosyada benzersiz alan yok dolayısıyla güncelleme/update sorgusunu doğrudan kullanamayız
eğer bu 15 alanın bileşimleri benzersizse olabilir. bu 15 alanın bileşimi benzersiz mi?
ama eklenecek veri çok fazla değilse @Haluk hocamın kodu işinizi fazlasıyla görür
ADO ile kapalı dosyaya veri eklemeyi önermemin nedeni hedef dosyada veriler/makrolar çoksa dosyanın açılmasının zaman almasıdır.
ama burada olan önce hedefteki verilerin silinip sonra eklenmesi.
benzersiz alan varsa, güncelleme ve sonrasında ekleme kısmen işe yarayabilir. ama excel silme işlemini desteklemediği için silinmesi gerekenler tam olarak silinemez 2. bir update ile boş değer atanabilir sadece.

Halil Hocam ilgi ve alakanız için teşekkürler,
aşağıdaki sorgu ile tek bir alan olarak ta ekleyebiliriz, bu şekilde veriler benzersiz olur

sorgu = "Select '@' & F1 & F2 & F3 & F4 & F5 & F6 & F7 & F8 & F9 & F10 & F11 & F12 & F13 & F14 & F15 From [Text$]" & _
" Where [F16] is not null "

iyi çalışmalar.

 

[Haluk]

İşinize yararsa, aşağıdaki kodu kullanın....

Sub Test()
    'Haluk - 04/01/2023
    '
    Dim adoCAT As Object, adoTable As Object, myFile As String
    Dim objConn As Object
    Dim ColumnCount As Integer, i As Integer
    
    myFile = ThisWorkbook.Path & "\Data.xlsx"
    
    If Dir(myFile, vbDirectory) <> "" Then Kill myFile
    
    Set adoCAT = CreateObject("ADOX.Catalog")
    
    adoCAT.ActiveConnection = "Provider=Microsoft.ACE.OLEDB.12.0" & _
                              ";Data Source=" & myFile & _
                              ";Extended Properties=Excel 12.0 Xml"
    
    Set adoTable = CreateObject("ADOX.Table")
    adoTable.Name = "Rapor"
    
    ColumnCount = Cells(1, Columns.Count).End(xlToLeft).Column
    
    For i = 1 To ColumnCount + 1
        Set adoColumn = CreateObject("ADOX.Column")
        adoColumn.Name = "F" & i
        adoTable.Columns.Append adoColumn
    Next
    
    adoCAT.Tables.Append adoTable
    
    
    Set objConn = CreateObject("ADODB.Connection")
    
    strArgs = "Driver={Microsoft Excel Driver (*.xls, *.xlsx, *.xlsm, *.xlsb)}; Readonly=False; DBQ=" & ThisWorkbook.FullName
    objConn.Open strArgs
       
    strSQL = " Insert Into [" & myFile & "].[Rapor$] Select * From [Text$] Where F16 Is Not Null"
    objConn.Execute (strSQL)
    
    Set objConn = Nothing
    Set adoTable = Nothing
    Set adoCAT = Nothing
End Sub

.

 

[tamer42]

Teşekkürler Haluk Hocam,
sağ olun, var olun

 

[Haluk]

Aşağıdaki kod ise, ekli "TestFile.text" dosyasında 15 sütunda yer alan verilerin arasında son sütunu "2" olanları alıp, "Data.xlsx" dosyasında "Rapor" sayfasına yazar.

Download files - Filemail

Click here to view and download these shared files from Filemail.com

www.filemail.com

Sub Test2()
    'Haluk - 04/01/2023
    '
    Dim adoCAT As Object, adoTable As Object, myFile As String
    Dim objConn As Object
    Dim ColumnCount As Integer, i As Integer
    
    myFile = ThisWorkbook.Path & "\Data.xlsx"
    
    If Dir(myFile, vbDirectory) <> "" Then Kill myFile
    
    Set objConn = CreateObject("ADODB.Connection")
    
    strArgs = "Driver={Microsoft Excel Driver (*.xls, *.xlsx, *.xlsm, *.xlsb)}; Readonly=False; DBQ=" & ThisWorkbook.FullName
    objConn.Open strArgs
    
    strSQL = " Select * From " & _
             "[Text;CharacterSet=65001;Database=" & ThisWorkbook.Path & ";HDR=No].[TestFile.txt]"
    
    Set RS = objConn.Execute(strSQL)
    
    ColumnCount = RS.Fields.Count
    
    
    Set adoCAT = CreateObject("ADOX.Catalog")
    
    adoCAT.ActiveConnection = "Provider=Microsoft.ACE.OLEDB.12.0" & _
                              ";Data Source=" & myFile & _
                              ";Extended Properties=Excel 12.0 Xml"
    
    
    Set adoTable = CreateObject("ADOX.Table")
    adoTable.Name = "Rapor"
    
    
    For i = 1 To ColumnCount
        Set adoColumn = CreateObject("ADOX.Column")
        adoColumn.Name = "F" & i
        adoTable.Columns.Append adoColumn
    Next
    
    adoCAT.Tables.Append adoTable
    
           
    strSQL = " Insert Into [" & myFile & "].[Rapor$] Select * From " & _
             "[Text;CharacterSet=65001;Database=" & ThisWorkbook.Path & ";HDR=No].[TestFile.txt] Where F15= 2"
    
    objConn.Execute (strSQL)
    
    Set objConn = Nothing
    Set adoTable = Nothing
    Set adoCAT = Nothing
End Sub

.