Solved: Convert to txt

[zennon]

Good After noon,

I'm looking to convert the attached sheet to a txt file where each row is continuous with no spaces, can this be done?

e.g.
aaaaaaaaabbbbbbbbbbbccccccccddddddddddd
aaaaaaaaabbbbbbbbbbbccccccccddddddddddd

Thanks

Dave
Attachment 5272

[mvidas]

Hi Dave,

If you don't mind having a space as a delimiter, you can save it as a .PRN file (one of the saveas options).

However you can also use a macro to accomplish the same thing but without that space. I'm going to attach an add-in I made that can do many things to text files, one of which is exporting to a fixed-width file (you can specify the column widths or just let it go automatically, which will determine the widest value for every column).

The code for the fixed width export module (if you dont want to use the whole add-in):[vba]Option Explicit
Option Base 1
Sub subExportFixedWidth()
Dim WidthPrompt As Boolean, SheetData() As Variant, ExpData() As Variant, i As Long
Dim ExpWidths() As Variant, ExpRG As Range, tempStr As String
Dim vFF As Long, vFile As String, RC As Long, CC As Long, r As Long, C As Long
On Error Resume Next
Set ExpRG = Application.InputBox("Please select the range to export", _
"Select range on worksheet", ActiveSheet.UsedRange.Address(0, 0), Type:=8)
On Error GoTo 0
If ExpRG Is Nothing Then Exit Sub
If ExpRG.Areas.Count > 1 Then
MsgBox "Please only select 1 continuous range to export. Exiting."
Exit Sub
End If
Select Case MsgBox("Do you want to manually specify the number of characters for " & _
"each exported column?" & vbCrLf & "(Clicking 'No' will use the longest cell in " & _
"each column as the exported width)", vbYesNo, "Do you want to specify column widths?")
Case vbYes: WidthPrompt = True
Case vbNo: WidthPrompt = False
End Select

'get filename for export
vFile = Application.GetSaveAsFilename("", "Text files,*.txt,All Files,*.*")
If LCase(vFile) = "false" Then Exit Sub 'user hit cancel

'transfer sheet data to array, set row/column count variables
SheetData = ExpRG.Value
RC = UBound(SheetData, 1)
CC = UBound(SheetData, 2)

'determine export widths based on longest cell in each column
ReDim ExpWidths(CC)
For C = 1 To CC
ExpWidths(C) = 0
For r = 1 To RC
If ExpWidths(C) < Len(SheetData(r, C)) Then ExpWidths(C) = Len(SheetData(r, C))
Next
Next

'get widths from user if desired
If WidthPrompt Then
For i = 1 To CC
Do
tempStr = InputBox("Please enter width for column " & Mid(Columns(i).Address, 2, _
InStr(1, Columns(i).Address, ":") - 2), "Longest width shown", ExpWidths(i))
If Len(tempStr) = 0 Then Exit Sub 'user hit cancel or entered blank length
Loop Until IsNumeric(tempStr)
ExpWidths(i) = CLng(tempStr)
Next
End If

'Create array of data to export
ReDim ExpData(RC, CC)
For C = 1 To CC
i = ExpWidths(C)
For r = 1 To RC
ExpData(r, C) = PadField(SheetData(r, C), i)
Next
Next

'Check if file exists already
If Len(Dir(vFile)) > 0 Then
Select Case MsgBox("'" & vFile & "' already exists. Would you like to add this " & _
"sheet to the file?" & vbCrLf & vbCrLf & "Clicking No will overwrite the file," & _
" clicking Yes will append to the file.", vbYesNoCancel, "File already exists")
Case vbCancel: Exit Sub
Case vbNo: Kill vFile
Case vbYes:
End Select
End If

'export data to file
vFF = FreeFile
Open vFile For Append As #vFF
For r = 1 To RC
tempStr = ""
For C = 1 To CC
tempStr = tempStr & ExpData(r, C)
Next
Print #vFF, tempStr
Next
Close #vFF

'clear variable memory
Set ExpRG = Nothing

MsgBox "Done! File saved to:" & vbCrLf & vFile
End Sub
Function PadField(ByVal aField As String, ByVal FieldLen As Long) As String
Dim aLen As Long
If FieldLen = 0 Then
PadField = ""
Exit Function
End If
aLen = Len(aField)
Select Case aLen
Case Is = FieldLen: PadField = aField
Case Is < FieldLen
If IsNumeric(aField) Then
PadField = Space$(FieldLen - aLen) & aField
Else
PadField = aField & Space$(FieldLen - aLen)
End If
Case Else: PadField = Left$(aField, FieldLen)
End Select
End Function[/vba]
Matt

[gnod]

[VBA]
Sub ExportToTxtFile()
Dim fNum As Long
Dim strPathFilename As String, strFilename As String, strLine As String
Dim intRow As Integer, intCol As Integer

fNum = FreeFile
strFilename = "Test.txt"
strPathFilename = ThisWorkbook.Path & "\" & strFilename

Open strPathFilename For Output As fNum
With Worksheets("Sheet1")
For intRow = 3 To .Cells(65536, 1).End(xlUp).Row
strLine = ""
For intCol = 1 To 14
strLine = strLine & .Cells(intRow, intCol)
Next intCol
Print #fNum, strLine
Next intRow
End With

Close #fNum
End Sub
[/VBA]

[zennon]

I have attached the output in text form.

First row is the output from gnod's script, what I need it row 2. It seems to be trimming the zero's from the numeric fields. What I need in the end result is all the rows to be a certain length with certain charachters in specific positions.

Dave
Attachment 5274

[mvidas]

Dave,

I haven't tested this, but if you add .Text to the end of the cell being checked here from the line in gnod's code, it should take what is shown rather than the underlying value:[VBA]strLine = strLine & .Cells(intRow, intCol).Text[/vba]Matt

[gnod]

it works..
Thanks Matt.. you help me twice today..
i'm trying to solve it using the format function but with no luck..

[zennon]

You have just saved a man's sanity. It works great.

Thanks

Dave