Macro to copy Data from Excel and creates Pipe Delimitted Txt file.

[sesgiri]

Hello,

Could anyone of you please have a look in to the below issue.

I have used below VBA Macro to create a Text file with Delimit from Excel.

Sub t()
Open "D:\Temp\test1.txt" For Output As #1
introw = 1
For Each c In Worksheets("Sheet2").UsedRange.Cells
If c.Row > introw Then
introw = c.Row
Print #1, vbNewLine
End If
Print #1, c.Text & "|"
Next c
Close #1
End Sub


------ Generated file was in below format. (Attached)
Sunil|
123456790|
SSN|
9.09E+08|
Sunil|
Esgiri|
|
|
Girish|

Required:

1) I want data only (A2- BO2) not the descriptions (A1 - BO1)
2) I want the Text file in following format Sunil|123456790|SSN|9.09E+08|Sunil|i|||Girish||

Please let me know, if you need any additional information.

Thanks,
Esgiri.

 

[Deepak]

Check this...

http://www.excelforum.com/excel-gen...file-with-no-delimiters-or-modifications.html

 

[sesgiri]

Thanks Deepak, will look in to it.

 

[sesgiri]

That topic wont help me Deepak. Please some one look in to this!

Thanks,
sesgiri.

 

[Deepak]

Check with it...

Option Explicit

Sub txtt_export()
Dim buf As String, col As Long, r As Long, ws As Worksheet

Set ws = ActiveSheet

Open "D:\Temp\test1.txt" For Output As #1
For r = 1 To ws.UsedRange.Rows.Count
    For col = 1 To ws.UsedRange.Columns.Count
            If col = ws.UsedRange.Columns.Count Then
               buf = buf & "|" & ws.Cells(r, col).Text
            Else
                buf = buf & "|" & ws.Cells(r, col).Text & ","
            End If
    Next col
    Write #1, Mid(Replace(buf, ",", ""), 2)
    buf = ""
Next r
Close #1
End Sub

 

[sesgiri]

Thanks a Ton Deepak. code looks promising.

Appreciate your help!!

Regards,
sesgiri

 

[sesgiri]

Deepak you are the man.Code worked absolutely fine.thanks again.

Regards,
sesgiri.

 

[Deepak]

Welcome Dear....

 

[Deepak]

As per your approach loop with below code!!

Option Explicit

Sub txt_export2()
Dim buf As String, col As Long, r As Long, ws As Worksheet
Dim d As String, rng As Range, c As Range, row As Long

Set ws = ActiveSheet
d = "|"

Open "C:\Users\Deepak\Desktop\A.txt" For Output As #1
With ws
    col = .UsedRange.Columns.Count
    row = .UsedRange.Rows.Count
        For r = 1 To row
            Set rng = .Range(.Cells(r, 1), .Cells(r, col))
                For Each c In rng
                    buf = buf & c.Text & d
                Next
                buf = Left(buf, Len(buf) - Len(d))
            Write #1, buf
        buf = ""
        Next r
End With
Close #1
Set rng = Nothing
Set ws = Nothing
End Sub