SQL sorguyu farklı bir dosyaya aktarmak

tamer42 · 4 Ocak 2024

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

C#:

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

.

Çok teşekkürler Haluk Hocam

Korhan Ayhan · 5 Ocak 2024

tamer42' Alıntı:
Çok teşekkürler Korhan Hocam

Hatlar karışmış..

tamer42 · 5 Ocak 2024

Korhan Ayhan' Alıntı:
Hatlar karışmış..

Haluk Hocam& Korhan Hocam her ikinize de sonsun teşekkürler,
iyi ki varsınız!

Haluk · 6 Ocak 2024

20 No'lu mesajdaki kodlar, text dosyasından alınan nümerik verileri kapalı durumdaki Excel dosyasına metin olarak aktarıyordu.

Aşağıdaki kod, bunun önüne geçerek verilerin nümerik olarak dosyaya aktarılmasını sağlıyor. Çeşitli SQL komut ve metotları kullanılmış olup, açıklamalara yer verilmiştir.

C#:

Option Explicit
'
Sub Test3()
    'Haluk - 05/01/2023
    '
    Dim adoCAT As Object, adoTable As Object, adoColumn As Object, myFile As String, strArgs As String
    Dim objConn As Object, strSQL As String, RS As Object
    Dim ColumnCount As Integer, i As Integer
    Dim strColumnSpec As String
   
    Const adVarWChar As Long = 202

'   Verilerin yazilacagi, olusturulacak kapali dosya
    myFile = ThisWorkbook.Path & "\Data.xlsx"
   
'   INTO parametresinde belirtilen dosya ve tablo yoksa, INSERT komutu otomatik olarak olusturur ve verileri en son bos siradan yazmaya baslar...
'   Excel'de SQL ile veri yazarken DELETE komutu calismadigi icin eski verileri gercek anlamda silemeyiz.
'   Bu nedenle her veri aktarimindan once dosyayi, dolayisiyle de tabloyu silip yeniden olusturmamiz gerekiyor....
    If Dir(myFile, vbDirectory) <> "" Then Kill myFile
   
'   Verilerin alinacagi text dosyasinda ("TestFile.txt") kac adet sutun yani, kac adet alan var....onu bulalim ve "ColumnCount" degiskenine atayalim!
    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
   
'   myFile degiskeninde tariflenen "Data.xlsx" dosyasini hazirla
    Set adoCAT = CreateObject("ADOX.Catalog")
   
    adoCAT.ActiveConnection = "Provider=Microsoft.ACE.OLEDB.12.0" & _
                              ";Data Source=" & myFile & _
                              ";Extended Properties=Excel 12.0 Xml"
   
   
'   Dosyada "Rapor" isimli bir tablo (sayfa) olustur...
    Set adoTable = CreateObject("ADOX.Table")
    adoTable.Name = "Rapor"
   
'   Olusturulan tablonun tamamlanabilmesi icin, tablonun icinde en az 1 adet alani tipiyle birlikte olusturmak gerekir...
    Set adoColumn = CreateObject("ADOX.Column")
    adoColumn.Name = "F100"      'Gecici olarak F100 baslikli bir alan olusturuyoruz
    adoColumn.Type = adVarWChar  'VBA maalesef "Append" metodunda daha baska tipte bir alan olusturmamiza izin vermiyor :(
    adoTable.Columns.Append adoColumn
   
    adoCAT.Tables.Append adoTable
   
'   Icinde 1 adet alan barindiran bir tabloya sahip olan Excel dosyasi olusturuldu. Simdi bu dosyayi ihtiyacimiza gore modifiye edebiliriz.
'   Olusturdugumuz "F100" baslikli alani silip, verilerin alinacagi text dosyasindaki alan adedi kadar, "Integer" tipinde yeni alan olusturuyoruz
    strSQL = "Alter Table [" & myFile & "].[Rapor$] Drop Column F100"
    objConn.Execute (strSQL)
   
    For i = 1 To ColumnCount
        strColumnSpec = strColumnSpec & "H" & i & " Integer, "
    Next
   
    strColumnSpec = Mid(strColumnSpec, 1, Len(strColumnSpec) - 2)
   
    strSQL = "Alter Table [" & myFile & "].[Rapor$] Add Column " & strColumnSpec
    objConn.Execute (strSQL)
     
'   Olusturdugumuz dosyadaki tabloya text dosyasindaki alanlari "Where...." ile kritere gore filtreleyerek aktariyoruz
    strSQL = " Insert Into [" & myFile & "].[Rapor$] Select * From " & _
             "[Text;CharacterSet=65001;Database=" & ThisWorkbook.Path & ";HDR=Yes].[TestFile.txt] Where F15= 2"
   
    objConn.Execute (strSQL)
   
'   Temizlik
    Set objConn = Nothing
    Set adoTable = Nothing
    Set adoCAT = Nothing
End Sub

.

tamer42 · 11 Ocak 2024

Haluk' Alıntı:

20 No'lu mesajdaki kodlar, text dosyasından alınan nümerik verileri kapalı durumdaki Excel dosyasına metin olarak aktarıyordu.

Aşağıdaki kod, bunun önüne geçerek verilerin nümerik olarak dosyaya aktarılmasını sağlıyor. Çeşitli SQL komut ve metotları kullanılmış olup, açıklamalara yer verilmiştir.

C#:

Option Explicit
'
Sub Test3()
    'Haluk - 05/01/2023
    '
    Dim adoCAT As Object, adoTable As Object, adoColumn As Object, myFile As String, strArgs As String
    Dim objConn As Object, strSQL As String, RS As Object
    Dim ColumnCount As Integer, i As Integer
    Dim strColumnSpec As String
 
    Const adVarWChar As Long = 202

'   Verilerin yazilacagi, olusturulacak kapali dosya
    myFile = ThisWorkbook.Path & "\Data.xlsx"
 
'   INTO parametresinde belirtilen dosya ve tablo yoksa, INSERT komutu otomatik olarak olusturur ve verileri en son bos siradan yazmaya baslar...
'   Excel'de SQL ile veri yazarken DELETE komutu calismadigi icin eski verileri gercek anlamda silemeyiz.
'   Bu nedenle her veri aktarimindan once dosyayi, dolayisiyle de tabloyu silip yeniden olusturmamiz gerekiyor....
    If Dir(myFile, vbDirectory) <> "" Then Kill myFile
 
'   Verilerin alinacagi text dosyasinda ("TestFile.txt") kac adet sutun yani, kac adet alan var....onu bulalim ve "ColumnCount" degiskenine atayalim!
    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
 
'   myFile degiskeninde tariflenen "Data.xlsx" dosyasini hazirla
    Set adoCAT = CreateObject("ADOX.Catalog")
 
    adoCAT.ActiveConnection = "Provider=Microsoft.ACE.OLEDB.12.0" & _
                              ";Data Source=" & myFile & _
                              ";Extended Properties=Excel 12.0 Xml"
 
 
'   Dosyada "Rapor" isimli bir tablo (sayfa) olustur...
    Set adoTable = CreateObject("ADOX.Table")
    adoTable.Name = "Rapor"
 
'   Olusturulan tablonun tamamlanabilmesi icin, tablonun icinde en az 1 adet alani tipiyle birlikte olusturmak gerekir...
    Set adoColumn = CreateObject("ADOX.Column")
    adoColumn.Name = "F100"      'Gecici olarak F100 baslikli bir alan olusturuyoruz
    adoColumn.Type = adVarWChar  'VBA maalesef "Append" metodunda daha baska tipte bir alan olusturmamiza izin vermiyor :(
    adoTable.Columns.Append adoColumn
 
    adoCAT.Tables.Append adoTable
 
'   Icinde 1 adet alan barindiran bir tabloya sahip olan Excel dosyasi olusturuldu. Simdi bu dosyayi ihtiyacimiza gore modifiye edebiliriz.
'   Olusturdugumuz "F100" baslikli alani silip, verilerin alinacagi text dosyasindaki alan adedi kadar, "Integer" tipinde yeni alan olusturuyoruz
    strSQL = "Alter Table [" & myFile & "].[Rapor$] Drop Column F100"
    objConn.Execute (strSQL)
 
    For i = 1 To ColumnCount
        strColumnSpec = strColumnSpec & "H" & i & " Integer, "
    Next
 
    strColumnSpec = Mid(strColumnSpec, 1, Len(strColumnSpec) - 2)
 
    strSQL = "Alter Table [" & myFile & "].[Rapor$] Add Column " & strColumnSpec
    objConn.Execute (strSQL)
   
'   Olusturdugumuz dosyadaki tabloya text dosyasindaki alanlari "Where...." ile kritere gore filtreleyerek aktariyoruz
    strSQL = " Insert Into [" & myFile & "].[Rapor$] Select * From " & _
             "[Text;CharacterSet=65001;Database=" & ThisWorkbook.Path & ";HDR=Yes].[TestFile.txt] Where F15= 2"
 
    objConn.Execute (strSQL)
 
'   Temizlik
    Set objConn = Nothing
    Set adoTable = Nothing
    Set adoCAT = Nothing
End Sub

.

Haluk Hocam merhaba,
buradaki kodları aşağıdaki bilgiler ışığında nasıl uyarlayabiliriz?

Çalışma dosyasının bulunduğu klasör içinde TEXT adında bir klasör var, klasörde 1'den fazla txt dosyası mevcut

ThisWorkbook.Path & "\TEXT\TestFile1.txt
ThisWorkbook.Path & "\TEXT\TestFile2.txt
........
..................
şeklinde olsun,
Buradaki tüm txt dosyaları standart ve 15 alan mevcut, bu 15 alanı birleştirerek, satırdaki tüm verileri tek bir alan haline getirerek;

Kod:

Select F1 & F2 & F3 & F4 & F5 & F6 & F7 & F8 & F9 & F10 & F11 & F12 & F13 & F14 & F15 From [TestFile.txt] Where F15= 2

1. txt dosyasının verilerini Data isimli dosyada "Rapor" sayfasının 1. sütununa;
2. txt dosyanın verilerini Data isimli dosyada "Rapor" sayfasının 2. sütununa;
3. txt dosyasının verilerini Data isimli dosyada "Rapor" sayfasının 3. sütununa;
.....................
...............................

aktarılması hususnda destek olursanız çok mennun olurum,
tekrar teşekkürler,

SQL sorguyu farklı bir dosyaya aktarmak

tamer42

Destek Ekibi

Download files - Filemail

Korhan Ayhan

Administrator

tamer42

Destek Ekibi

Haluk

Özel Üye

tamer42

Destek Ekibi