• DİKKAT

    DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
    Altın Üyelik Hakkında Bilgi

Ado ile kapalı txt veri alma hk.

@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)

.
 

Ekli dosyalar

Son düzenleme:
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)

.
Genişletmek için tıkla ...
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.
 
Ö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.

.
 
Son düzenleme:
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.

.
Genişletmek için tıkla ...
Evet Haluk bey, gelen veriler yeterli. Verilerin birim değerleri yazmasa da olur. Sadece sayısal değerleri kullanıyorum.
 
sekozzy' Alıntı:
Evet Haluk bey, gelen veriler yeterli. Verilerin birim değerleri yazmasa da olur. Sadece sayısal değerleri kullanıyorum.
Genişletmek için tıkla ...


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.



.Capture.PNG
 
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
Genişletmek için tıkla ...
Ü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.
 
O zaman tamam, benim açımdan bu iş bitti diye düşünüyorum ben ....

Size kolay gelsin,

.
 
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 & "]"


.
 
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 & "]"


.
Genişletmek için tıkla ...
Peki Haluk Bey, bu kodları 20.mesajda bulunan örneğe uyarlayabilir misiniz vaktiniz varsa. Ben o dosyaya uyarlamaya çalışıyorum ama hata alıyorum.
 
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
 
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.
Genişletmek için tıkla ...

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.

.
 

Ekli dosyalar

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
Genişletmek için tıkla ...
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.

.
Genişletmek için tıkla ...

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.
 
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
 
Son düzenleme:
Hepinizden özür dilerim arkadaşlar. x32 ve x64 makrosu zaten kodun içindeymiş. Sizleri rahatsız ettiğim için kusura bakmayın.
 
Son düzenleme:
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 & "]"
Genişletmek için tıkla ...
 
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

.
Genişletmek için tıkla ...

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.
 

Ekli dosyalar

  • 17.JPG
    17.JPG
    22.5 KB · Görüntüleme: 4
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ı.


.
 
Son düzenleme:
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ı.


.
Genişletmek için tıkla ...

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.
 

Ekli dosyalar

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

.
Genişletmek için tıkla ...
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
 

Ekli dosyalar

Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst