Macro for export

[santaviga]

Hi to all.

I need some help with exporting excel data to text file, I have data in
cells throughout the worksheet, what I need is a macro to export the data in
all cells to a text file on the desktop, but these need to be a maximum of 12
characters and if not 12 character it needs to be padded out to 12 characters
so that when it exports to a text file the data is displayed as if in colums
and not all over the place.

Also I need to know how it exports e.g every time I save the file will it
export to a text file on desktop?

I am currenty doing this a long way by formulas but I think would be better
if it was done by a macro.

I thankyou in advance

Any help would be much appreciated I am new to macros

Regards

 

[Joel]

Sub WriteFixed()

Const MyPath = "C:\temp\"
Const WriteFileName = "text.txt"

Const ForReading = 1, ForWriting = 2, ForAppending = 3

Const TristateUseDefault = -2, TristateTrue = -1, TristateFalse = 0

Set fswrite = CreateObject("Scripting.FileSystemObject")

'open files
WritePathName = MyPath + WriteFileName
fswrite.CreateTextFile WritePathName
Set fwrite = fswrite.GetFile(WritePathName)
Set tswrite = fwrite.OpenAsTextStream(ForWriting, TristateUseDefault)

LastRow = Cells(Rows.Count, "A").End(xlUp).Row

For RowCount = 1 To LastRow
LastCol = Cells(RowCount, Columns.Count).End(xlToLeft).Column
OutPutLine = ""
For Colcount = 1 To LastCol
Data = Cells(RowCount, Colcount).Text
If Len(Data) < 12 Then
Data = Data & WorksheetFunction.Rept(" ", 12 - Len(Data))
End If
OutPutLine = OutPutLine & Data
Next Colcount
tswrite.writeline OutPutLine
Next RowCount

tswrite.Close

End Sub

 

[santaviga]

Hi Joel,

I have input the code you supplied and it works to an extent, when it runs
the macro to export the data to text file, the text is all joined and not in
columns, is there anywhere I need to put in so if there is only 5 characters
it will pad the text out to 12 and therefore keep the text file as if it were
in columns?

Many thanks

 

[santaviga]

Just noticed also that in the text file it is exporting all text and not the
first 12 characters of each cell. Any ideas???

Regards

 

[Joel]

I added one line of code
Sub WriteFixed()

Const MyPath = "C:\temp\"
Const WriteFileName = "text.txt"

Const ForReading = 1, ForWriting = 2, ForAppending = 3

Const TristateUseDefault = -2, TristateTrue = -1, TristateFalse = 0

Set fswrite = CreateObject("Scripting.FileSystemObject")

'open files
WritePathName = MyPath + WriteFileName
fswrite.CreateTextFile WritePathName
Set fwrite = fswrite.GetFile(WritePathName)
Set tswrite = fwrite.OpenAsTextStream(ForWriting, TristateUseDefault)

LastRow = Cells(Rows.Count, "A").End(xlUp).Row

For RowCount = 1 To LastRow
LastCol = Cells(RowCount, Columns.Count).End(xlToLeft).Column
OutPutLine = ""
For Colcount = 1 To LastCol
Data = Cells(RowCount, Colcount).Text
If Len(Data) < 12 Then
Data = Data & WorksheetFunction.Rept(" ", 12 - Len(Data))
else
Data = left(Data,12)
End If
OutPutLine = OutPutLine & Data
Next Colcount
tswrite.writeline OutPutLine
Next RowCount

tswrite.Close

End Sub

 

[santaviga]

Hi, now working to export 12 character but still not padding out in text form
e.g adding spaces to text below 12 cgaracters to form column like text in
text file

Many thanks for you help

 

[santaviga]

I basically need the data exported to text file but when looking at the text
file I need each column to be separated.

Thanks

 

[Joel]

I added 5 spaces between columns



Sub WriteFixed()

Const MyPath = "C:\temp\"
Const WriteFileName = "text.txt"

Const ForReading = 1, ForWriting = 2, ForAppending = 3

Const TristateUseDefault = -2, TristateTrue = -1, TristateFalse = 0

Set fswrite = CreateObject("Scripting.FileSystemObject")

'open files
WritePathName = MyPath + WriteFileName
fswrite.CreateTextFile WritePathName
Set fwrite = fswrite.GetFile(WritePathName)
Set tswrite = fwrite.OpenAsTextStream(ForWriting, TristateUseDefault)

LastRow = Cells(Rows.Count, "A").End(xlUp).Row

For RowCount = 1 To LastRow
LastCol = Cells(RowCount, Columns.Count).End(xlToLeft).Column
OutPutLine = ""
For Colcount = 1 To LastCol
Data = Cells(RowCount, Colcount).Text
If Len(Data) < 12 Then
Data = Data & WorksheetFunction.Rept(" ", 12 - Len(Data))
else
Data = left(Data,12)
End If
if OutPutline <> "" then
OutPutLine = OutPutLine & " "
end if
OutPutLine = OutPutLine & Data
Next Colcount
tswrite.writeline OutPutLine
Next RowCount

tswrite.Close

End Sub

 

[santaviga]

its getting there.

Looks like

DATA DATA DATA
DATA DATA DATA

instead of looking like this

DATA DATA DATA DATA
DATA DATA DATA DATA

anything I can do to fix this as it goes through the text file and theres a
lot of data to do it individually.

Regards

 

[Joel]

I don't think the problem is with the program. I think there arre leading
and trailing spaces in the data in the cell. I added a trim function to
remove the spaces at the beginning and end of the data before adding the
spaces back in top make all the data 12 spaces lonjg..


Sub WriteFixed()

Const MyPath = "C:\temp\"
Const WriteFileName = "text.txt"

Const ForReading = 1, ForWriting = 2, ForAppending = 3

Const TristateUseDefault = -2, TristateTrue = -1, TristateFalse = 0

Set fswrite = CreateObject("Scripting.FileSystemObject")

'open files
WritePathName = MyPath + WriteFileName
fswrite.CreateTextFile WritePathName
Set fwrite = fswrite.GetFile(WritePathName)
Set tswrite = fwrite.OpenAsTextStream(ForWriting, TristateUseDefault)

LastRow = Cells(Rows.Count, "A").End(xlUp).Row

For RowCount = 1 To LastRow
LastCol = Cells(RowCount, Columns.Count).End(xlToLeft).Column
OutPutLine = ""
For Colcount = 1 To LastCol
Data = trim(Cells(RowCount, Colcount).Text)
If Len(Data) < 12 Then
Data = Data & WorksheetFunction.Rept(" ", 12 - Len(Data))
else
Data = left(Data,12)
End If
if OutPutline <> "" then
OutPutLine = OutPutLine & " "
end if
OutPutLine = OutPutLine & Data
Next Colcount
tswrite.writeline OutPutLine
Next RowCount

tswrite.Close

End Sub