Ado ile kapalı txt veri alma hk.

Haluk · 26 Kasım 2018

@sekozzy ;

Yukarıda 3. ve 12. mesajlarda belirtildiği gibi tarih içeren dosya isimlerinin, arka planda düzeltilmesi ve sonrasında; ADO ile Excel sayfasına Schema.ini dosyasında belirtilen özelliklere göre sütunlara ayrıştırılmasına yönelik bir çalışma ektedir.

Ekli sıkıştırılmış dosyanın içindeki Schema.ini, text dosyası ve Excel dosyası aynı klasöre yerleştirildikten sonra, Excel dosyasındaki makroyu çalıştırmak için sayfadaki butona tıklayın.

İstediğinize yakın bir sonuç aldıysanız, 16. mesajda belirttiğiniz düzenlemeleri yapabilirsiniz.

Not: Ekli RAR dosyası yenilendi (Saat:15:38)

.

sekozzy · 26 Kasım 2018

Haluk' Alıntı:
@sekozzy ;

Yukarıda 3. ve 12. mesajlarda belirtildiği gibi tarih içeren dosya isimlerinin, arka planda düzeltilmesi ve sonrasında; ADO ile Excel sayfasına Schema.ini dosyasında belirtilen özelliklere göre sütunlara ayrıştırılmasına yönelik bir çalışma ektedir.

Ekli sıkıştırılmış dosyanın içindeki Schema.ini, text dosyası ve Excel dosyası aynı klasöre yerleştirildikten sonra, Excel dosyasındaki makroyu çalıştırmak için sayfadaki butona tıklayın.

İstediğinize yakın bir sonuç aldıysanız, 16. mesajda belirttiğiniz düzenlemeleri yapabilirsiniz.

Not: Ekli RAR dosyası yenilendi (Saat:15:38)

.

Haluk Bey, öncelikle sizin de vermiş olduğunuz emeklerden ötürü size de teşekkür ediyorum. Sizlerin sayesinde farklı yöntemler olduğunu da görmüş oldum. Fakat en son eklemiş olduğum dosyayı indirip incelerseniz tam olarak kodlarımın nasıl çalıştığını göreceksiniz. Sizin vermiş olduğunuz dosyada yanlış anlamadıysam Schema.ini text dosyası ve excel dosyası aynı klasörde olmalı? Ama benim text dosyalarım her gün için ayrı klasörlerde olacak. Yanlış yorumladıysam kusuruma bakmayın. Kodları çok iyi bilmediğim için bu şekilde yorumladım.

Haluk · 26 Kasım 2018

Öncelikle siz çıkan sonuçlara bakın, işinize yarıyor mu ?

Çünkü; text dosyasında birimi kcal/m3 olan verilerin son sütunu TAB ile ayrılmamış...... Bunları sizin bir şekilde verileri aldığınız program ayarlarıyla düzeltmeniz gerekecek.

Not: Schema.ini dosyasının text dosyalarıyla aynı yerde olmasına gerek yok, kodların çalıştırıldığı Excel dosyası ile aynı yerde olması yeterli.

.

sekozzy · 26 Kasım 2018

Haluk' Alıntı:
Öncelikle siz çıkan sonuçlara bakın, işinize yarıyor mu ?

Çünkü; text dosyasında birimi kcal/m3 olan verilerin son sütunu TAB ile ayrılmamış...... Bunları sizin bir şekilde verileri aldığınız program ayarlarıyla düzeltmeniz gerekecek.

Not: Schema.ini dosyasının text dosyalarıyla aynı yerde olmasına gerek yok, kodların çalıştırıldığı Excel dosyası ile aynı yerde olması yeterli.

.

Evet Haluk bey, gelen veriler yeterli. Verilerin birim değerleri yazmasa da olur. Sadece sayısal değerleri kullanıyorum.

Haluk · 26 Kasım 2018

sekozzy' Alıntı:
Evet Haluk bey, gelen veriler yeterli. Verilerin birim değerleri yazmasa da olur. Sadece sayısal değerleri kullanıyorum.

Azizim, ben de bundan bahsediyorum zaten ...... kodu çalıştırdıktan sonra örneğin 11. veriye ait sonucu gördünüz mü? Dediğim nedenden ötürü buradaki nümerik değerler ayrıştırılamıyor.

.

sekozzy · 26 Kasım 2018

Haluk' Alıntı:
Azizim, ben de bundan bahsediyorum zaten ...... kodu çalıştırdıktan sonra örneğin 11. veriye ait sonucu gördünüz mü? Dediğim nedenden ötürü buradaki nümerik değerler ayrıştırılamıyor.

.Ekli dosyayı görüntüle 200523

Üstad o önemli değil parçaal fonksiyonu ile onları ayrıştırırım. Önemli olan A, B, C, D sütunlarına ve F19, F20, F21 hücrelerine gelen değerler.

Haluk · 26 Kasım 2018

O zaman tamam, benim açımdan bu iş bitti diye düşünüyorum ben ....

Size kolay gelsin,

.

Haluk · 26 Kasım 2018

Son bir bilgi daha vereyim...

Koddaki;

Kod:

strSQL = "Select * from [" & myFile & "]"

satırı yerine, aşağıdakini de kullanabilirsiniz ve burada; Schema.ini dosyasında tarif edilen ancak, Excel dosyasına aktarılmasını istemediğiniz sütun başlıklarını silerek, geriye kalan sütunların Excel sayfasına aktarılmalarını sağlayabilirsiniz.

Kod:

strSQL = "Select [Başlık1], [Başlık2], [Başlık3], [Başlık4], [Başlık5], [Başlık6]  from [" & myFile & "]"

.

sekozzy · 26 Kasım 2018

Haluk' Alıntı:
Son bir bilgi daha vereyim...

Koddaki;

Kod:

strSQL = "Select * from [" & myFile & "]"

satırı yerine, aşağıdakini de kullanabilirsiniz ve burada; Schema.ini dosyasında tarif edilen ancak, Excel dosyasına aktarılmasını istemediğiniz sütun başlıklarını silerek, geriye kalan sütunların Excel sayfasına aktarılmalarını sağlayabilirsiniz.

Kod:

strSQL = "Select [Başlık1], [Başlık2], [Başlık3], [Başlık4], [Başlık5], [Başlık6] from [" & myFile & "]"

.

Peki Haluk Bey, bu kodları 20.mesajda bulunan örneğe uyarlayabilir misiniz vaktiniz varsa. Ben o dosyaya uyarlamaya çalışıyorum ama hata alıyorum.

Erdem Akdemir · 26 Kasım 2018

Haluk bey yine işi bitirmiş.
Yalnız 64 office kullananlar kodu aşağıdaki gibi revize etmeliler.
Sayın sekozzy hata alma sebebiniz 64 bit ofis'ten dolayı olabilir.

Kod:

Sub Test4()
    'Haluk - 26/11/2018
    '
    Dim objConn As Object, RS As Object, FSO As Object
    Dim j As Integer
   
       aa = Application.Version
   
    Const adOpenForwardOnly = 0
    Const adLockReadOnly = 1
    Const adCmdText = 1
   
    Range("A1:G" & Rows.Count) = Empty
   
    strFile = Application.GetOpenFilename("Text dosyaları,*.txt")
    If strFile = False Then Exit Sub
   
    TempFile = ThisWorkbook.Path & Application.PathSeparator & "Temp.txt"
   
    Name strFile As TempFile
   
    Set objConn = CreateObject("ADODB.Connection")
    Set RS = CreateObject("ADODB.Recordset")
    Set FSO = CreateObject("Scripting.FileSystemObject")
   
    myFile = FSO.getFileName(TempFile)
    myFolder = FSO.GetFile(TempFile).ParentFolder.Path & Application.PathSeparator
   

     #If Win64 Then
    objConn.Open "Driver=Microsoft Access Text Driver (*.txt, *.csv);" & _
                 "Dbq=" & myFolder & ";Extensions=asc,csv,tab,txt;"
#Else
    objConn.Open "Driver={Microsoft  Text Driver (*.txt; *.csv)};" & _
                "Dbq=" & myFolder & ";Extensions=asc,csv,tab,txt;"

#End If

    strSQL = "Select * from [" & myFile & "]"
    RS.Open strSQL, objConn, adOpenForwardOnly, adLockReadOnly, adCmdText
   
'    For j = 0 To RS.Fields.Count - 1
'        Cells(1, j + 1) = RS.Fields(j).Name
'    Next
   
    Range("A2").CopyFromRecordset RS
    RS.Close
   
    Name TempFile As strFile
   
    Set RS = Nothing
    objConn.Close
    Set objConn = Nothing
End Sub

Haluk · 26 Kasım 2018

sekozzy' Alıntı:
Peki Haluk Bey, bu kodları 20.mesajda bulunan örneğe uyarlayabilir misiniz vaktiniz varsa. Ben o dosyaya uyarlamaya çalışıyorum ama hata alıyorum.

Kodların 20. mesajdaki dosyanıza göre düzenlenmiş şekli ektedir.

Ekli RAR dosyasını açın ve içindeki Schema.ini dosyasını ve Excel dosyasını bir klasöre yerleştirin. Verilerin bulunduğu text dosyaları da belirttiğiniz gibi D:\HESAP olarak olmalı.

Benim Excel 32 Bit (Windows değil...... Excel mimarisi) olduğu için bir hata almıyorum, eğer sizin Excel versiyonu yukarıda Erdem Beyin bahsettiği gibi 64 Bit ise ve hata alıyorsanız; kendisinin belirttiği değişikliği yaparsınız.

.

sekozzy · 27 Kasım 2018

Erdem_34' Alıntı:

Haluk bey yine işi bitirmiş.
Yalnız 64 office kullananlar kodu aşağıdaki gibi revize etmeliler.
Sayın sekozzy hata alma sebebiniz 64 bit ofis'ten dolayı olabilir.

Kod:

Sub Test4()
    'Haluk - 26/11/2018
    '
    Dim objConn As Object, RS As Object, FSO As Object
    Dim j As Integer
  
       aa = Application.Version
  
    Const adOpenForwardOnly = 0
    Const adLockReadOnly = 1
    Const adCmdText = 1
  
    Range("A1:G" & Rows.Count) = Empty
  
    strFile = Application.GetOpenFilename("Text dosyaları,*.txt")
    If strFile = False Then Exit Sub
  
    TempFile = ThisWorkbook.Path & Application.PathSeparator & "Temp.txt"
  
    Name strFile As TempFile
  
    Set objConn = CreateObject("ADODB.Connection")
    Set RS = CreateObject("ADODB.Recordset")
    Set FSO = CreateObject("Scripting.FileSystemObject")
  
    myFile = FSO.getFileName(TempFile)
    myFolder = FSO.GetFile(TempFile).ParentFolder.Path & Application.PathSeparator
  

     #If Win64 Then
    objConn.Open "Driver=Microsoft Access Text Driver (*.txt, *.csv);" & _
                 "Dbq=" & myFolder & ";Extensions=asc,csv,tab,txt;"
#Else
    objConn.Open "Driver={Microsoft  Text Driver (*.txt; *.csv)};" & _
                "Dbq=" & myFolder & ";Extensions=asc,csv,tab,txt;"

#End If

    strSQL = "Select * from [" & myFile & "]"
    RS.Open strSQL, objConn, adOpenForwardOnly, adLockReadOnly, adCmdText
  
'    For j = 0 To RS.Fields.Count - 1
'        Cells(1, j + 1) = RS.Fields(j).Name
'    Next
  
    Range("A2").CopyFromRecordset RS
    RS.Close
  
    Name TempFile As strFile
  
    Set RS = Nothing
    objConn.Close
    Set objConn = Nothing
End Sub

Haluk' Alıntı:
Kodların 20. mesajdaki dosyanıza göre düzenlenmiş şekli ektedir.

Ekli RAR dosyasını açın ve içindeki Schema.ini dosyasını ve Excel dosyasını bir klasöre yerleştirin. Verilerin bulunduğu text dosyaları da belirttiğiniz gibi D:\HESAP olarak olmalı.

Benim Excel 32 Bit (Windows değil...... Excel mimarisi) olduğu için bir hata almıyorum, eğer sizin Excel versiyonu yukarıda Erdem Beyin bahsettiği gibi 64 Bit ise ve hata alıyorsanız; kendisinin belirttiği değişikliği yaparsınız.

.

Haluk bey ve Erdem bey, ikinize de çok teşekkür ederim. Hem verdiğiniz emeklerden ötürü hem de vakit ayırıp yardımcı olduğunuz için minnettarım. Kodun son hali tam istediğim gibi çalışıyor. Sistemim 64bit fakat Haluk bey'in gönderdiği dosyayı aynen çalıştırdım sorun çıkmadı. Her türlü duruma karşı Erdem bey sizin kodunuzu da yedek olarak alıp kaydettim. Tekrar teşekkürler, iyi çalışmalar hepinize sağolun.

sekozzy · 17 Nisan 2019

Merhaba arkadaşlar, office x64 kullanıyordum ve altın üyeliğim bitmiş bu neden 32bit sürüme göre olan kodu indiremiyorum. Rica etsem aşağıdaki kodda hangi satırları nasıl değiştirirsem 32 bit sürümde de kullanabilirim?

Mevcut kodlarla
[Microsoft][ODBC Driver Manager] Veri kaynağı adı bulunamadı ve varsayılan sürücü belirtilmemiş
uyarısı alıyorum.

Kod:

Sub txt_veri_al()
With Sheets("Sayfa1")
    Dim objConn As Object, RS As Object, FSO As Object
    Dim j As Integer
       aa = Application.Version
    Const adOpenForwardOnly = 0
    Const adLockReadOnly = 1
    Const adCmdText = 1
   
'    Range("I237:R" & Rows.Count) = Empty
    Range("I240:R330").ClearContents
   
    dosya_yolu = Range("U1").Text & Application.PathSeparator & Range("U2").Text & Application.PathSeparator
    dosya = Range("U3").Text
    strFile = dosya_yolu & dosya
   
    If Dir(strFile) = "" Then
        MsgBox dosya & Chr(10) & "Adlı Dosya Bulunamadı!", vbCritical, "Hata !"
        Exit Sub
    End If
   
    TempFile = ThisWorkbook.Path & Application.PathSeparator & "Temp.txt"
   
    Name strFile As TempFile
   
    Application.Wait Now + TimeValue("00:00:01")
   
    Set objConn = CreateObject("ADODB.Connection")
    Set RS = CreateObject("ADODB.Recordset")
    Set FSO = CreateObject("Scripting.FileSystemObject")
   
#If Win64 Then
    objConn.Open "Driver=Microsoft Access Text Driver (*.txt, *.csv);" & _
                 "Dbq=" & ThisWorkbook.Path & ";Extensions=asc,csv,tab,txt;"
#Else
    objConn.Open "Driver={Microsoft  Text Driver (*.txt; *.csv)};" & _
                "Dbq=" & ThisWorkbook.Path & ";Extensions=asc,csv,tab,txt;"

#End If
'    objConn.Open "Driver={Microsoft Text Driver (*.txt; *.csv)};" & _
'                 "Dbq=" & ThisWorkbook.Path & ";Extensions=asc,csv,tab,txt;"
   
    strSQL = "Select * from [Temp.txt]"
'    strSQL = "Select [Başlık1], [Başlık2], [Başlık3], [Başlık4], [Başlık5], [Başlık6]  from [" & myFile & "]"
   
    RS.Open strSQL, objConn, adOpenForwardOnly, adLockReadOnly, adCmdText
   
'    For j = 0 To RS.Fields.Count - 1
'        Cells(1, j + 1) = RS.Fields(j).Name
'    Next
   
    Range("I240").CopyFromRecordset RS
    RS.Close
   
    Name TempFile As strFile
   
    Set RS = Nothing
    objConn.Close
    Set objConn = Nothing
End With
End Sub

sekozzy · 17 Nisan 2019

Hepinizden özür dilerim arkadaşlar. x32 ve x64 makrosu zaten kodun içindeymiş. Sizleri rahatsız ettiğim için kusura bakmayın.

erenb · 26 Aralık 2022

Merhaba.
Konuyu uzun süreden sonra yeniden gündeme getiriyorum ama verilen örnekler çalıştırldığında virgülden sonrasını hep farklı sütuna yazıyor. Acaba aynı paragrafı bölmeden, olduğu gibi hücreye kopyalamak için ne yapılması gerekiyor?

Örnek

con.Open _
"Provider=Microsoft.ace.OLEDB.12.0;Data Source=" & yol & ";Extended Properties=""text;HDR=No;FMT=Delimited """

sorgu = "select * from [" & x & "]"

tamer42 · 3 Mart 2023

Haluk' Alıntı:
Alan adında (yani, dosya adında) boşluk varsa, köşeli parantez içinde kullanmak gerekir. ....... [Dosya Adı] gibi.

Ancak, sizdeki sorun; dosya adı olan tarih biçiminde "nokta" kullanılmasından kaynaklanıyor.

Masaüstündeki "Text" dosyasının adını 19-11-2018 DOSYASI olarak değiştirin, kodu da bu şekilde kullanın.

Kod:

Sub txtado() Set con = CreateObject("ADODB.Connection") yol = "C:\Users\" & Environ("UserName") & "\Desktop" x = "19-11-2018 DOSYASI.txt" con.Open _ "Provider=Microsoft.ace.OLEDB.12.0;Data Source=" & yol & ";Extended Properties=""text;HDR=No;FMT=Delimited""" sorgu = "select * from [" & x & "]" Set rs = con.Execute(sorgu) Range("a1").CopyFromRecordset rs End Sub

.

Haluk Hocam merhaba,
TXT dosyasına veri eklemek için kod üzerinde aşağıdaki gibi bir düzenleme yaptım, yalnız ekli hata mesajını verdi, nasıl bir düzenme yapmak gerekir?

ilginiz için şimdiden teşekkürler,

Kod:

Sub txtado()

Set con = CreateObject("ADODB.Connection")

myPath = ThisWorkbook.Path

yol = "C:\Users\" & Environ("UserName") & "\Desktop"

x = "firstTable.txt"

con.Open _
"Provider=Microsoft.ace.OLEDB.12.0;Data Source=" & myPath & ";Extended Properties=""text;HDR=No;FMT=Delimited"""

'''sorgu = "select * from [" & x & "]"
'''Set RS = con.Execute(sorgu)
'''Range("a1").CopyFromRecordset RS

sorgu = "INSERT INTO [firstTable.txt] Values ('smth', 'smth2', 'smth3', 'smth4', 'smth5', 'smth6', 'smth7');"

Set RS = con.Execute(sorgu)


End Sub

iyi Çalışmalar.

Haluk · 3 Mart 2023

Verdiği hata mesajı gayet açık ve yapmanız gereken de belli......

Masaüstü'ndeki mevcut "firstTable.txt" dosyasının ilk satırında virgülle ayrılmış 7 adet alan adı olmalı.

.

tamer42 · 3 Mart 2023

Haluk' Alıntı:
Verdiği hata mesajı gayet açık ve yapmanız gereken de belli......

Masaüstü'ndeki mevcut "firstTable.txt" dosyasının ilk satırında virgülle ayrılmış 7 adet alan adı olmalı.

.

Haluk Hocam teşekkür ederim,

Aşağıdaki linkteki yazışmalarımızdan esinlenerek; sayfa içindeki belirlenen tüm hücre aralığını bir seferde TXT dosyasına aktarmak için kodu nasıl düzenleyebiliriz?

https://www.excel.web.tr/threads/excel-den-sql-e-veri-goenderim-metotlari.170560/#post-1156215

Bu yöntemi denedim ama; olmadı

Kod:

sorgu = "INSERT INTO [" & ff & "] FROM [Sayfa11$A14:G]" & _
               "IN '' [EXCEL 12.0;DATABASE=" & ThisWorkbook.FullName & "]"

sizi yorduğumuz için lütfen kusura bakmayın,

tekrar teşekkürler,
iyi Çalışmalar.

yakamozexcel · 4 Mart 2023

Teşekkürler çalışma için

tamer42 · 1 Ocak 2024

Haluk' Alıntı:
Alan adında (yani, dosya adında) boşluk varsa, köşeli parantez içinde kullanmak gerekir. ....... [Dosya Adı] gibi.

Ancak, sizdeki sorun; dosya adı olan tarih biçiminde "nokta" kullanılmasından kaynaklanıyor.

Masaüstündeki "Text" dosyasının adını 19-11-2018 DOSYASI olarak değiştirin, kodu da bu şekilde kullanın.

Kod:

Sub txtado() Set con = CreateObject("ADODB.Connection") yol = "C:\Users\" & Environ("UserName") & "\Desktop" x = "19-11-2018 DOSYASI.txt" con.Open _ "Provider=Microsoft.ace.OLEDB.12.0;Data Source=" & yol & ";Extended Properties=""text;HDR=No;FMT=Delimited""" sorgu = "select * from [" & x & "]" Set rs = con.Execute(sorgu) Range("a1").CopyFromRecordset rs End Sub

.

Haluk Hocam önclikle mutlu yıllar,
Yeni yılın hepimize sağlık, mutluluk ve huzur getirmesi dileğiyle...

ekli txt dosyasında virgül ile ayrılmış 15 değer (sütun) bulunmakta;
Burada şu şekilde bir sorgu oluşturabiliyor muyuz?
5. sütunda "1" olanlar, 6. sütunda "0" olanlar gibi

Kod:

WHERE [F5]=1

gibi...
ilginize şimdiden teşekkürler

Ado ile kapalı txt veri alma hk.

Haluk

Özel Üye

Ekli dosyalar

sekozzy

Haluk

Özel Üye

sekozzy

Haluk

Özel Üye

sekozzy

Haluk

Özel Üye

Haluk

Özel Üye

sekozzy

Erdem Akdemir

Destek Ekibi

Haluk

Özel Üye

Ekli dosyalar

sekozzy

sekozzy

sekozzy

erenb

tamer42

Destek Ekibi

Ekli dosyalar

Haluk

Özel Üye

tamer42

Destek Ekibi

Ekli dosyalar

yakamozexcel

tamer42

Destek Ekibi

Ekli dosyalar