Tek-Tips is the largest IT community on the Internet today!

Members share and learn making Tek-Tips Forums the best source of peer-reviewed technical information on the Internet!

  • Congratulations Westi on being selected by the Tek-Tips community for having the most helpful posts in the forums last week. Way to Go!

Parsing Through VBA on a .txt Import in ACCESS 2000

Status
Not open for further replies.

PSUIVERSON

Technical User
Nov 6, 2002
95
US
I basically wrote some VBA that emulates the Import wizard in ACCESS 2000. Pretty simple stuff but I've found that some of the .txt files are not parsing correctly and only import as 1 field!?

Is there a way to parse in VBA? Right now I use this simple block to emulate the .txt import. Would i need to write detailed code to look for certain points and break it up and write to .mdb in a loop of some sort?

Current code it import:

DoCmd.TransferText _
TransferType:=acImportDelim, _
tableName:=tblNAME, _
FileName:=filePath, _
HasFieldNames:=fieldHeadings

This was fine but now it's not working that great. Is it the acImportDelim? Should I change that?

Any help would be great...thanks...
 
Here is a partial example of reading and EDI text file and parsing the record. Should give you an idea - a bit lengthy.


Function ReadTextFile(pathname As String) As Variant
Dim inLine As String, RecType As String
Dim data1 As String
Dim retCode As Variant
'-----
'------pathname = "C:\edi\850in\imports\850test1.txt"
Open pathname For Input As #1

Do While Not EOF(1)
Line Input #1, inLine
glbSegmentName = Mid(inLine, 1, 5)
RecType = Mid(inLine, 1, 5)
data1 = Mid(inLine, 1, 1405)

Select Case RecType 'choose import based on first 5
Case "HDBEG"
retCode = WriteHDBEGTable(data1)
Case "HDSAC"
retCode = WriteHDSACTable(data1)
Case "HDN1 "
retCode = WriteHDN1Table(data1)
Case "DTPO1"
retCode = WriteDTPO1Table(data1)
Case "DTOTH"
retCode = WriteDTOTHTable(data1)
Case "DTSAC"
retCode = WriteDTSACTable(data1)
Case "DTN1 "
retCode = WriteDTN1Table(data1)
Case Else
MsgBox "Unrecognized record type in FileLine " & glbSegmentName
End Select
Debug.Print "records segment = "; glbSegmentName
Debug.Print "data1 = "; data1
Loop
Close #1


End Function

Function WriteHDBEGTable(data1) As Variant
Dim RST1 As New Recordset
'Dim cnn As ADODB.Connection
'Set cnn = CurrentProject.Connection

'------- Open Head850BEG table for update
RST1.Open "Head850BEG", glbcnn, adOpenKeyset, adLockOptimistic

'--- create Export records
RST1.AddNew
RST1!segmentName = glbSegmentName
'--- Parse data for fields each data is 255 except the last one
RST1!segmentCode = Mid(data1, 6, 5)
RST1!customerPO = Mid(data1, 11, 15)
RST1!customerID = Mid(data1, 26, 15)
RST1!salesOrderNumber = " " '36-15
RST1!BEG01 = Mid(data1, 56, 2)
RST1!BEG02 = Mid(data1, 58, 2)
RST1!BEG03 = Mid(data1, 60, 22)
RST1!BEG04 = Mid(data1, 82, 30)
RST1!BEG05 = Mid(data1, 112, 8)
RST1!BEG06 = Mid(data1, 120, 30)
RST1!CUR01 = Mid(data1, 150, 3)
RST1!CUR02 = Mid(data1, 153, 3)

RST1!REF01A = Mid(data1, 156, 3)
RST1!REF02A = Mid(data1, 159, 30)
RST1!REF041A = Mid(data1, 189, 3)
RST1!REF042A = Mid(data1, 192, 30)
RST1!REF01B = Mid(data1, 222, 3)
RST1!REF02B = Mid(data1, 225, 30)
RST1!REF041B = Mid(data1, 255, 3)
RST1!REF042B = Mid(data1, 258, 2)
RST1!REF01C = Mid(data1, 288, 3)
RST1!REF02C = Mid(data1, 291, 30)
RST1!REF041C = Mid(data1, 321, 3)
RST1!REF042C = Mid(data1, 324, 30)

RST1!PER01A = Mid(data1, 354, 2)
RST1!PER02A = Mid(data1, 356, 60)
RST1!PER03A = Mid(data1, 416, 2)
RST1!PER04A = Mid(data1, 418, 80)
RST1!PER05A = Mid(data1, 498, 2)
RST1!PER06A = Mid(data1, 500, 35)
RST1!PER07A = Mid(data1, 540, 2)
RST1!PER08A = Mid(data1, 542, 40)
RST1!PER01B = Mid(data1, 582, 2)
RST1!PER02B = Mid(data1, 584, 60)
RST1!PER03B = Mid(data1, 644, 2)
RST1!PER04B = Mid(data1, 646, 80)
RST1!PER05B = Mid(data1, 726, 2)
RST1!PER06B = Mid(data1, 728, 40)
RST1!PER07B = Mid(data1, 768, 2)
RST1!PER08B = Mid(data1, 770, 40)

RST1!FOB01 = Mid(data1, 810, 2)
RST1!ITD01 = Mid(data1, 812, 2)
RST1!ITD02 = Mid(data1, 814, 2)
RST1!ITD03 = Mid(data1, 816, 6)
RST1!ITD04 = Mid(data1, 822, 8)
RST1!ITD05 = Mid(data1, 830, 3)
RST1!ITD06 = Mid(data1, 833, 8)
RST1!ITD07 = Mid(data1, 841, 3)
RST1!ITD08 = Mid(data1, 844, 10)
RST1!ITD12 = Mid(data1, 854, 80)

RST1!DTM01A = Mid(data1, 934, 3)
RST1!DTM02A = Mid(data1, 937, 8)
RST1!DTM01B = Mid(data1, 945, 3)
RST1!DTM02B = Mid(data1, 948, 8)
RST1!DTM01C = Mid(data1, 956, 3)
RST1!DTM02C = Mid(data1, 959, 8)
RST1!DTM01D = Mid(data1, 967, 3)
RST1!DTM02D = Mid(data1, 970, 8)
RST1!DTM01E = Mid(data1, 978, 3)
RST1!DTM02E = Mid(data1, 981, 8)
RST1!DTM01F = Mid(data1, 989, 3)
RST1!DTM02F = Mid(data1, 992, 8)
RST1!DTM01G = Mid(data1, 1000, 3)
RST1!DTM02G = Mid(data1, 1003, 8)
RST1!DTM01H = Mid(data1, 1011, 3)
RST1!DTM02H = Mid(data1, 1014, 8)

RST1!DTM01I = Mid(data1, 1022, 3)
RST1!DTM02I = Mid(data1, 1025, 8)
RST1!DTM01J = Mid(data1, 1033, 3)
RST1!DTM02J = Mid(data1, 1036, 8)
RST1!TD502A = Mid(data1, 1044, 2)
RST1!TD503A = Mid(data1, 1046, 80)
RST1!TD504A = Mid(data1, 1126, 2)
RST1!TD505A = Mid(data1, 1128, 35)
RST1!TD512A = Mid(data1, 1163, 2)
RST1!MAN01A = Mid(data1, 1165, 2)
RST1!MAN02A = Mid(data1, 1167, 48)
RST1!MAN01A = Mid(data1, 1215, 2)
RST1!MAN02A = Mid(data1, 1217, 48)

RST1.Update
RST1.Close

End Function
 
Thanks. I was afraid it was long-winded. I'll let you know what I come up with...
 
Status
Not open for further replies.

Part and Inventory Search

Sponsor

Back
Top