Excel VBA

Write a Text File

My friend came to me with a text file that he needed to extract 3 elements on suceeding lines and re-arrange them into a new order. Bringing the 4,800 row text file directly into Excel caused things to be split in an uncomfortable order and was going to take a lot of programming.

Hope this workaround works for you. And by the way, doing it this way, the entire thing ran in less than 3 seconds.

Option Explicit

Public TexName As String, DaNum, DaDate
Public Row1, roW2, newFname, xlName, daTime

'+-------------------------------------------
'| 1. Open the original text file, parse first line
'| 2. Parse the second line
'| 3. Write to a new text file in the perferred format
'| 4. Open the new text file and SaveAs XLS
'+----------------------------------------------

Sub ChangeFileAround()
    Close #1, #2
    TexName = InputBox("The the text file name", "Name", _
        ThisWorkbook.Path & "\OrigFile.TXT")
    newFname = Application.Text(Now(), "yyddmm") _
        & "file" & Hex(Hour(Now())) & ".txt"    'Write name
    Open ThisWorkbook.Path & "\" & newFname For Output As #2
    Open TexName For Input Access Read As #1
    Do While Not EOF(1) 'Read #1
        Line Input #1, Row1
            DaNum = Mid(Row1, 7, 4) 'Start pos 7 for 4 chars
            DaDate = Right(Row1, 10) 'right 10 chars
        Line Input #1, roW2 	'next line
            daTime = Left(roW2, 6)
        Print #2, DaNum; DaDate; daTime 'space 'em out
    Loop    'get the next group
    Close #1, #2    'close them up
    openNewF
    MsgBox "Finished writing new file to " _
        & ThisWorkbook.Path & "\" & xlName, vbOKOnly, "Done"
End Sub

Sub openNewF()
        Workbooks.OpenText Filename:=ThisWorkbook.Path & _
	    "\" & newFname, _
            Origin:=xlWindows, startrow:=1,
    DataType:=xlFixedWidth, _
            FieldInfo:=Array(Array(0, 1), Array(4, 1), _
    Array(15, 1))
        xlName = Left(newFname, Len(newFname) - 4) & ".XLS"
        Application.DisplayAlerts = False 'Turn off warning
        ActiveWorkbook.SaveAs Filename:=xlName, FileFormat:= _
            xlNormal
        Application.DisplayAlerts = True 'Turn back on
    End Sub