Çözüldü metin belgesine veri gönderme

[bycakir]

merhaba arkadaşlar.

a stunundaki dolu hücre sayısına göre c stunundaki verileri metin belgesine nasıl aktarırım. sorum biraz daha genişlecek ama ilk etapta bunu bulmam gerekiyor.

teşekkürler.

 

[Haluk]

Merhaba,

-"txt" uzantılı metin belgesi mevcut mu, yeni mi oluşturulacak?

-Yeni oluşturulacaksa, adını nerden alacak?

-C sütunundaki verilerin tipi nedir? (Nümerik, metin v.s.)

-Örnek dosyanızı eklerseniz daha iyi olur....

.

 

[bycakir]

Dosyayı ekledim aslında burada c stununda birleştir komutu içinde kullandığım kodlar var bu birleştirin içinde a ve b stunundan aldıgı veri var geri kalan değerler aynı bu c stununu tamamen kaldırıp macroya alabilirmiyiz. bu kodlar IFS programı için önemli kodlar acıkta kalmasını istemiyorum.
yardımlarınız için şimdiden teşekkürler.

 

[Haluk]

Bahsettiğiniz IFS programı nedir, bilmiyorum.

Aşağıdaki kodlar; Excel dosyasının bulunduğu yerde "Deneme.txt" isimli bir dosya oluşturur....

Sub Test()
    'Haluk - 09/01/2019
    'E-Posta: sa4truss@gmail.com
    '
    Dim myFile As String, adoStream As Object, NoA As Long, i As Long
    Const adSaveCreateOverWrite = 2
    
    myFile = ThisWorkbook.Path & Application.PathSeparator & "Deneme.txt"
    
    Set adoStream = CreateObject("ADODB.Stream")
    adoStream.Charset = "utf-8"
    adoStream.Type = 2
    adoStream.Open
    
    NoA = Range("A" & Rows.Count).End(xlUp).Row
    For i = 1 To NoA
        adoStream.WriteText Cells(i, 3)
        adoStream.WriteText vbCrLf
    Next
    
    adoStream.SaveToFile myFile, adSaveCreateOverWrite
    adoStream.Close
    
    Set adoStream = Nothing
End Sub

.

 

[Haluk]

Eğer "C"sütununu hiç kullanmak istemiyorsanız, o zaman aşağıdakini kullanabilirsiniz....

Sub Test2()
    'Haluk - 09/01/2019
    'E-Posta: sa4truss@gmail.com
    '
    Dim myFile As String, adoStream As Object, NoA As Long, i As Long, myData As String
    Const adSaveCreateOverWrite = 2
    
    myFile = ThisWorkbook.Path & Application.PathSeparator & "Deneme.txt"
    
    Set adoStream = CreateObject("ADODB.Stream")
    adoStream.Charset = "utf-8"
    adoStream.Type = 2
    adoStream.Open
    
    NoA = Range("A" & Rows.Count).End(xlUp).Row
    
    adoStream.WriteText "!IFS.COPYOBJECT"
    adoStream.WriteText vbCrLf
    adoStream.WriteText "$LU=ShopOrd"
    adoStream.WriteText vbCrLf
    adoStream.WriteText "$VIEW=SHOP_ORD"
    adoStream.WriteText vbCrLf
    
    For i = 4 To NoA
        myData = "$RECORD=!-$3:=" & Range("A" & i) & "-$11:=TEC04-$18:=" & _
                 Range("B" & i).Text & "-$19:=" & Range("B" & i).Text & "-$23:=1-$27:=1-$28:=*" & _
                 "-$30:=*-$29:=1-$26:=Üretim-$63:=YENİ-$96:=*-"
        adoStream.WriteText myData
        adoStream.WriteText vbCrLf
    Next
    
    adoStream.SaveToFile myFile, adSaveCreateOverWrite
    adoStream.Close
    
    Set adoStream = Nothing
End Sub

.

 

[bycakir]

hocam çok teşekkurler kod 2 mükemmel sadece alt+enter ler yok bunları nasıl ekleyebilirim?

 

[veyselemre]

hocam çok teşekkurler kod 2 mükemmel sadece alt+enter ler yok bunları nasıl ekleyebilirim?

Böyle mi?

    For i = 4 To NoA
        myData = "$RECORD=!" & vbCrLf & _
                 "-$3:=" & Range("A" & i) & vbCrLf & _
                 "-$11:=TEC04" & vbCrLf & _
                 "-$18:=" & Range("B" & i).Text & vbCrLf & _
                 "-$19:=" & Range("B" & i).Text & vbCrLf & _
                 "-$23:=1" & vbCrLf & _
                 "-$27:=1" & vbCrLf & _
                 "-$28:=*" & vbCrLf & _
                 "-$30:=*" & vbCrLf & _
                 "-$29:=1" & vbCrLf & _
                 "-$26:=Üretim" & vbCrLf & _
                 "-$63:=YENİ" & vbCrLf & _
                 "-$96:=*" & vbCrLf & _
                 "-"
        adoStream.WriteText myData
        adoStream.WriteText vbCrLf
    Next

 

[bycakir]

yok hocam ekxcell deki gibi olmalı bunu aktar dediğimde normal enter gibi aktarıyor. fakat yukarıdaki excelin c stununu kopyalayıp not defterine attığımda tek satır gosteriyor ama alt enter oldugundan daha sonrasında kullanımım için uygun oluyor.

 

[Haluk]

Excel'den kopyala yapıştır ile elde ettiğim Copy-Paste.txt ve Test2 isimli makrodan elde ettiğim Deneme.txt dosyaları ektedir.

Bunların her ikisi de birbirinin aynı....

Siz farklı bir şey istiyorsanız, örnek bir txt dosyası yükleyin bence....

.

 

[bycakir]

günaydın Haluk bey;

aslı eklediğim dosyadadır. dosyada -$ ların önünde ALT+ENTER vardır yon tusları ile hareket ettiğinizde farkedeceksiniz. excellden txt dosyasına bu şekilde aktarım yapabilirmiyiz. not ilk yazdığınız c stununu kopyalayan kod doğru çalışıyor. ALT+ENTER olan yerler geliyor. bunu 2 koda kodu macro ile yazdırdığımızda yaptıramıyoruz.

 

[Haluk]

Günaydın, sanırım şimdi anladım..... Aşağıdaki kodu deneyebilirsiniz

Sub Test3()
    'Haluk - 10/01/2019
    'E-Posta: sa4truss@gmail.com
    '
    Dim myFile As String, adoStream As Object, NoA As Long, i As Long, myData As String
    Const adSaveCreateOverWrite = 2
    
    myFile = ThisWorkbook.Path & Application.PathSeparator & "Deneme.txt"
    
    Set adoStream = CreateObject("ADODB.Stream")
    adoStream.Charset = "utf-8"
    adoStream.Type = 2
    adoStream.Open
    
    NoA = Range("A" & Rows.Count).End(xlUp).Row
    
    adoStream.WriteText "!IFS.COPYOBJECT"
    adoStream.WriteText vbCrLf
    adoStream.WriteText "$LU=ShopOrd"
    adoStream.WriteText vbCrLf
    adoStream.WriteText "$VIEW=SHOP_ORD"
    adoStream.WriteText vbCrLf
    
    For i = 4 To NoA
        myData = "$RECORD=!" & vbLf & "-$3:=" & Range("A" & i) & vbLf & "-$11:=TEC04" & vbLf & "-$18:=" & _
                 Range("B" & i).Text & vbLf & "-$19:=" & Range("B" & i).Text & vbLf & "-$23:=1" & vbLf & "-$27:=1" & vbLf & "-$28:=*" & _
                 vbLf & "-$30:=*" & vbLf & "-$29:=1" & vbLf & "-$26:=Üretim" & vbLf & "-$63:=YENİ" & vbLf & "-$96:=*-"
        adoStream.WriteText myData
        adoStream.WriteText vbCrLf
    Next
    
    adoStream.SaveToFile myFile, adSaveCreateOverWrite
    adoStream.Close
    
    Set adoStream = Nothing
End Sub

.

 

[bycakir]

ellerinize sağlık Haluk bey süpersiniz. çok teşekkürler.