Macro to convert ASCII File to Excell

T

TXDalessandros

I get files daily from differnet vendors in ASCII format. The line breaks
are noted by the ~ST and the columns are denoted by *. Below is an example
of a few lines.

ISA*00* *00* *ZZ*DHLCIDI *ZZ*TRN200175
*100126*02
8*U*00400*000000142*1*P*>~GS*IA*DHLCIDI*TRN200175*20100126*0208*142*X*004010~ST
110*1420001~B3**AUSD000000017**MX**20100125*27629****DHLC*20100125~B3A*DR*1~C3*U
SD**USD~ITD*05*3****20100209*15~N1*BT*DELL DMS*25*00797056329~N3*501 DELL
WAY~N4
*ROUND ROCK*TX*786820001*US~LX*1~N1*SH*DELL DMS*25*00797056329~N3*200 DELL
WAY B
LDG RR 5 RO~N4*ROUND ROCK*TX*786820001*US~PER*SH*DELL COMPUTER~N1*CN*DEL
TDC~N3*
TUN HUA S RD~N4*TAIPEI**99999*TW~PER*DC*S FANGI J
WEN~P1**20090716*011****1~R1*D
HLC*AIR*AUS*DHL*TPE~RMT*AW*003479667520*276.29~NTE*CUS*DUTIABLE
SHIPMENT~L5*1***
*PKG90~L0*1*39*LB*20*A1***1*PCS**L~SL1*CX***6329
/H1***PP**I~L1*1*269.55*VS*26
955****400****FRT CHRG AMT~L1*2*6.74*VS*674****405****FUEL
SURCHARGE~C3*USD*1.0
0*USD~L3*39*B***27629*******L~SE*29*1420001~ST*110*1420002~B3**AUSD000000018**M
**20100125*14857****DHLC*20100125~B3A*DR*1~C3*USD**USD~ITD*05*3****20100209*15~N
1*BT*DELL DMS*25*00797056329~N3*501 DELL WAY~N4*ROUND
ROCK*TX*786820001*US~LX*1~
N1*SH*DELL DMS*25*00797056329~N3*501 DELL WAY*TX~N4*ROUND
ROCK**786820001*US~PER
*SH*HOLLY ARNOLD~N1*CN*MITAC COMPUTER~N3*1/F 97 HO YEUNG ST*NT~N4*TUEN
MUN*NT*99
999*HK~PER*DC*CHRISTINE
LEE~P1**20090720*011****1~R1*DHLC*AIR*AUS*DHL*HKG~RMT*AW
*003480062401*148.57~NTE*CUS*DUTIABLE
SHIPMENT~L5*1****PKG90~L0*1*14*LB*3*A1***1


I need to make these into readable lines an columns rather quickly each
morning. I would like to use a macro to do this incase I am out others could
use this as well.

Thank you,
Holly
 
M

Matthew Herbert

Holly,

I've listed some sample code below for your reference. The code is NOT
tested, but it should work and the comments should be enough for you to adapt
the code accordingly. At a minimum, you'll need to change the "strFileName"
and "rngAnchor" variables within the code. (There are ways to make
strFileName and rngAnchor more dynamic (as opposed to being hard-coded
values), but you should be able to do that if required). Be sure to take a
look at the .TextToColumns parameters and ensure the accuracy of those
arguments (i.e. set the parameters to fit your situation and note that I
haven't listed all possible parameters). Lastly, are you sure there are no
line feed characters in the file?

Best,

Matthew Herbert

Sub CustomParseText()
Dim intFile As Integer
Dim strFileName As String
Dim strText As String
Dim varArr As Variant
Dim strSepLine As String
Dim strSepCol As String
Dim strTemp As String
Dim rngAnchor As Range
Dim lngRow As Long
Dim intCol As Integer
Dim intCntCol As Integer

'CHANGE AS NEEDED
strFileName = "C:\test.txt"

'get a free file number for the Open statement
intFile = FreeFile()

'This works too: Open strFileName For Input As #intFile
Open strFileName For Binary Access Read As #intFile

'get the text in the file
strText = input(FileLen(strFileName), intFile)

'close the file b/c there is no more need for it
Close intFile

strSepLine = "~ST"
strSepCol = "*"

'test that strSepLine exists and handle accordingly
If InStr(1, strText, strSepLine) = 0 Then
MsgBox "No line characters found. Exiting the procedure."
Exit Sub
End If

'split by line
varArr = Split(strText, "~ST")

'set the output location (CHANGE AS NEEDED)
Set rngAnchor = Worksheets(1).Range("A1")

With rngAnchor
lngRow = .Row
intCol = .Column
End With

With rngAnchor.Parent

'you may want to test if the data will fit in the worksheet
' relative to the anchor location. For example, you
' could do something like the following to test the rows:
'If (lngRow + UBound(varSplit) - 1) > .Rows.Count Then Exit Sub

'If you don't have uniform column counts on each line within
' the file, then the following will need to be adapted,
' otherwise, you could use the code to test the column fit
' relative to the anchor location:
'strTemp = varArr(0)
'intCntCol = Len(strTemp) - Len(Replace(strTemp, strSepCol, ""))
'If (intCol + intCntCol) > .Columns.Count Then Exit Sub

'output the array to the worksheet (Split creates a
' zero-based array)
Range(.Cells(lngRow, intCol), _
.Cells(lngRow + UBound(varArr) - 1, intCol)) = _
Application.WorksheetFunction.Transpose(varArr)


'--------------------------------------------------------------------------------
'May need to handle the "Do you want to replace the contents..."
' MsgBox that appears with the .TextToColumns if you are
' overwriting data. (You could clear the worksheet and/or
' output area prior to output, you could use
' Application.DisplayAlerts, or use some other method to
' account for this potential scenario).

'split the text into columns, set the parameters accordingly
Range(.Cells(lngRow, intCol), _
.Cells(lngRow + UBound(varArr) - 1, intCol)).TextToColumns
DataType:=xlDelimited, _
TextQualifier:=xlTextQualifierNone, ConsecutiveDelimiter:=False,
Tab:=False, _
Semicolon:=False, Comma:=False, Space:=False, Other:=True,
OtherChar:=strSepCol

'--------------------------------------------------------------------------------
End With

End Sub
 
M

Matthew Herbert

Holly,

Sorry for the vagaries, but what I mean by "line feed" is this: Is there a
vbLf (Chr(10) or CHAR(10)), vbCr (Chr(13) or CHAR(13)), or vbCrLf (Chr(13) +
Chr(10)) character in the text file? (You can do a search within VBE help
for "Miscellaneous Constants" to reference what I'm talking about). If so,
then you will likely get some unexpected results and thus need to adjust for
these special characters.

Best,

Matt
 
T

TXDalessandros

I was able to remove the hard returns in the txt file with a find and replace
prior to using this so that helped.

Is there anyway now since the columns are not uniform to find say a cell
value of AW and then copy the cell adjancent to it to another worksheet?
 
M

Matthew Herbert

Holly,

You shouldn't need to do a find and replace on the raw data; simply adjust
the macro to handle the raw data. (As you said, if you're not around and
someone else has to run this process and the someone else doesn't do the find
and replace, then it won't work anyway). As far as finding the "AW," are you
looking to obtain every entry after "AW," or do you have something else in
mind? If you want every value after the "AW," and between the "*"s, then see
the code below. For example, if your data were like
"...*AW*003479667520*276...", the macro would return "003479667520". Note
that you'll have to do something with the result, which is being printed to
the Immediate Window (VBE: View|Immediate Window) for now.

Best,

Matt

Sub FindTextAfterAW()
Dim intFile As Integer
Dim strFileName As String
Dim strText As String
Dim lngPosTxt As Long
Dim lngPosStar1 As Long
Dim lngPosStar2 As Long

'CHANGE AS NEEDED
strFileName = "C:\test.txt"

'get a free file number for the Open statement
intFile = FreeFile()

'This works too: Open strFileName For Input As #intFile
Open strFileName For Binary Access Read As #intFile

'get the text in the file
strText = Input(FileLen(strFileName), intFile)

'close the file b/c there is no more need for it
Close intFile

lngPosTxt = 1
lngPosStar1 = 0
lngPosStar2 = 0
Do
lngPosTxt = InStr(lngPosStar2 + 1, strText, "AW")
If lngPosTxt = 0 Then Exit Do

'locate the text after the "AW" and in between the two "*"s
lngPosStar1 = InStr(lngPosTxt + 1, strText, "*")
If lngPosStar1 = 0 Then Exit Do

lngPosStar2 = InStr(lngPosStar1 + 1, strText, "*")
If lngPosStar2 = 0 Then Exit Do

'do something with the result
If lngPosStar1 + 1 = lngPosStar2 Then
Debug.Print "No text between the stars"
Else
Debug.Print Mid(strText, lngPosStar1 + 1, _
lngPosStar2 - lngPosStar1 - 1)
End If
Loop

End Sub
 
C

Chip Pearson

I posted this yesterday but it doesn't seem to have made it to the
server.


Try code like that shown below. You need to set a reference to the
scripting runtime library. In VBA, go to the Tools menu, choose
References, and scroll down to "Microsoft Scripting Runtime" and check
that entry. The scripting runtime library contains the
FileSystemObject and TextStream objects that are used to read the
input file. Once you have set that reference, it will travel with the
workbook, so you don't need to set it every time you use the code, and
if you distribute the workbook to others, they will not need to go
through the referencing steps.

The code will, for example, transform the input text

abc*def*ghi-ST123*456-STxyz*one*two*three

to an Excel range

abc def ghi
123 456
xyz one two three

In the code, change StartRow and StartCol to the location where the
import process will start writing to the worksheet. If you set
StartRow and/or StartCol to less than or equal to zero, the starting
row and column will be the row and column of the currently active
cell.

Sub AAA()

Dim FName As Variant
Dim Lines() As String
Dim Cols() As String
Dim TS As TextStream
Dim FSO As Scripting.FileSystemObject
Dim S As String
Dim LNdx As Long
Dim CNdx As Long
Dim RowNdx As Long
Dim ColNdx As Long
Dim StartRow As Long
Dim StartCol As Long

StartRow = 3 '<<< CHANGE
StartCol = 4 '<<< CHANGE

If StartRow <= 0 Then
StartRow = ActiveCell.Row
End If
If StartCol <= 0 Then
StartCol = ActiveCell.Column
End If


Set FSO = New Scripting.FileSystemObject
FName = Application.GetOpenFilename("All files (*.*),*.*")
If FName = False Then
Exit Sub
End If
Set TS = FSO.OpenTextFile(CStr(FName), ForReading, _
False, TristateUseDefault)
S = TS.Read(FileLen(CStr(FName)))
Lines = Split(S, "-ST")
For LNdx = LBound(Lines) To UBound(Lines)
Cols = Split(Lines(LNdx), "*")
RowNdx = RowNdx + 1
ColNdx = 0
For CNdx = LBound(Cols) To UBound(Cols)
ColNdx = ColNdx + 1
Cells(StartRow + RowNdx - 1, _
StartCol + ColNdx - 1).Value = Trim(Cols(CNdx))
Next CNdx
Next LNdx
TS.Close
End Sub



Cordially,
Chip Pearson
Microsoft MVP 1998 - 2010
Pearson Software Consulting, LLC
www.cpearson.com
[email on web site]
 
Top