ExcelBanter

ExcelBanter (https://www.excelbanter.com/)
-   Excel Programming (https://www.excelbanter.com/excel-programming/)
-   -   Help with code (https://www.excelbanter.com/excel-programming/404576-help-code.html)

santaviga

Help with code
 
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


I have input the code and it works to an extent, when it runs
the macro to export the data to text file, the text is still out of
alignment like

da da da da
da da da da

instead of should be like this

da da da da
da da da da

when the data exports to a text file in needs to be in columns as theres a
lot of data
but it can only max of 12 characters long and the data less than 12
characters needs
to be padded out in spaces

Many thanks please see the code below


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




joel

Help with code
 
See earlier posting. Trim function needs to be added to code.

"santaviga" wrote:

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


I have input the code and it works to an extent, when it runs
the macro to export the data to text file, the text is still out of
alignment like

da da da da
da da da da

instead of should be like this

da da da da
da da da da

when the data exports to a text file in needs to be in columns as theres a
lot of data
but it can only max of 12 characters long and the data less than 12
characters needs
to be padded out in spaces

Many thanks please see the code below


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





All times are GMT +1. The time now is 03:02 PM.

Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
ExcelBanter.com