UtterAccess.com
X   Site Message
(Message will auto close in 2 seconds)

Welcome to UtterAccess! Please ( Login   or   Register )

Custom Search
 
   Reply to this topicStart new topic
> Import Edi File Into Access Line By Line, Access 2003    
 
   
paccus
post Mar 2 2018, 08:51 AM
Post#1



Posts: 3
Joined: 2-March 18



Hi,
I need to import into Access table this EDI text file ( ' as line terminator):

UNA:+.?'
UNB+UNOC:3+BRANDEUROPE+ANYCODE+180206:1121+5439'
UNH+5439-1+DESADV:D:99B:UN'
BGM+351+0089430043+9'
DTM+11:20180205:102'
DTM+137:20180205:102'
MEA+WT+AAD+KGM:2126.100'
MEA+CT+SQ+NMP:00000'
NAD+DP+0017309707++NameStreet 22+Rome++00100+IT'
CTA+DL'
NAD+SU+DE++BRAND Systems+Rome+Rome++00100+IT'
CTA+DL'
TOD+6++CIP'
CPS+1'
PAC+2++BX'
MEA+WT+G+KGM:88'
PCI+24'
GIN+ML+AL7B009435+AL7B009438'
LIN+1++46550705:VP'
PIA+1+4114793:BP'
IMD+A++:::C833dn-EURO'
QTY+12:2'
RFF+OP:44CKV07S:000001'
CPS+2'
PAC+1++BX'
MEA+WT+G+KGM:0.01'
PCI+24'
LIN+1++01182907:VP'
PIA+1+4113617:BP'
IMD+A++:::RAM-256MB-C3/C5/C6/C7/MC3/MC5/C8'
QTY+12:1'
RFF+OP:44CKV07S:000003'
CPS+3'
PAC+4++BX'
MEA+WT+G+KGM:43.2'
PCI+24'
LIN+1++46361802:VP'
PIA+1+4114805:BP'
IMD+A++:::Tray-C5x2/MC5x3'
QTY+12:4'
RFF+OP:44CKV07S:000006'

This is the result I need:

0089430043 05/02/2018 46550705 AL7B009435
0089430043 05/02/2018 46550705 AL7B009438
etc...

and this is what I tried:

Public Function import1()

Dim strFilename As String: strFilename = "C:\despatch.txt"
Dim strTextLine, CodProd, DataDoc As String
Dim SNarray() As String
Dim NumDoc As Long
Dim nPAC, NumRig, intCount As Integer
Dim iFile As Integer: iFile = FreeFile

Open strFilename For Input As #iFile

Do Until EOF(1)
Line Input #1, strTextLine
strTextLine = Replace(strTextLine, "'", "")

'BGM
If Left(strTextLine, 3) = "BGM" Then
NumDoc = Mid(strTextLine, 9, 10)
End If

'DTM
If Left(strTextLine, 6) = "DTM+11" Then
DataDoc = Mid(strTextLine, 14, 2) & "/" & Mid(strTextLine, 12, 2) & "/" & Mid(strTextLine, 8, 4)
End If

'CPS = numero record
If Left(strTextLine, 3) = "CPS" Then
NumRig = Val(Mid(strTextLine, 5, 3))
End If

'PAC = numero di matricole da estrarre
If Left(strTextLine, 3) = "PAC" Then
nPAC = Val(Mid(strTextLine, 5, 3))
End If

'GIN
If Left(strTextLine, 3) = "GIN" Then

'strTextLine.MoveNext

End If

'LIN
If Left(strTextLine, 3) = "LIN" Then
CodProd = Mid(strTextLine, 8, 8)
End If

'strTextLine.MovePrevious

SNarray = Split(Mid(strTextLine, 8), "+")

For intCount = LBound(SNarray) To UBound(SNarray)
Debug.Print NumDoc & " " & DataDoc & " " & NumRig & " " & CodProd & " " & SNarray(intCount)
Next
'strTextLine.MovePrevious
'strTextLine.MovePrevious
Loop
Close #iFile
End Function

Before to import GIN record with serial numbers, I need to achieve the LIN record with che product code, and then pass them to variables. I've tried with .MoveNext and then with two .MovePrevious but it gives me error: object needed.

Any help would be appreciated. Thanks.
Go to the top of the page
 
zaxbat
post Mar 2 2018, 09:42 AM
Post#2



Posts: 1,184
Joined: 26-January 06
From: .....the wiregrass (either you know or you don't)


In order to use the movenext, moveprev, etc. you should access the file in a different manner. Something like what you see below...only problem is that the data needs to be in a DAO.Recordset TYPE table first.


Dim myDb As DAO.Database
Dim myRS As DAO.Recordset

Set myDb = CurrentDb
Set myRS = myDb.OpenRecordset("tmptbl")

If myRS.RecordCount > 0 Then
myRS.MoveFirst
While Not myRS.EOF
'BGM
If Left(myRS.Fields("ImportEntireRecAsOneField"), 3) = "BGM" Then
NumDoc = Mid(myRS.Fields("ImportEntireRecAsOneField"), 9, 10)
End If
myRS.MoveNext
Wend
End If

myRS.close
set myRS = nothing



RuralGuy has a great idea.....if the file is in a weird format that Access does not expect....why not just put it into the format that Access expects then process normally?

Does the input file have crLF or does the ' symbol do that function in the system that hosts this file?

If you can currently do line input # and it works brining in only one line....then the file does indeed have vbCrLf at the end of each line and the ' symbol is completely unnecessary.
However, I suspect that it is a binary file with no vbCrLF and the ' symbol allows you to delineate records. If the filesize is not up in the gigs.....just read the whole thing and replace the ' with vbCrLf and replace the + with ,
After that (assuming my assumptions are correct) you can just do a normal import for CSV type file.
This post has been edited by zaxbat: Mar 2 2018, 09:49 AM

--------------------
Kindest regards, and Cheers!
ZAX

A picture is worth a thousand words and a zipped DB is worth a thousand pictures.
Oh, and....please don't disappear into the Twilight Zone.... Holler back with your results!
Go to the top of the page
 
RuralGuy
post Mar 2 2018, 09:43 AM
Post#3


UtterAccess VIP
Posts: 2,826
Joined: 25-June 05
From: @ 8300' in the Colorado Rocky Mountains


It is just a thought but if you replaced the "'" with a CrLf and wrote it back out to a temp file, you would be able to read the temp file and loop on Line Input #1 and it would make the whole process easier to understand. Just a thought. laugh.gif

--------------------
(RG for short) aka Allan Bunch Previous MS Access MVP acXP, ac07, ac10, ac13 - WinXP Pro, Win7 Pro, Win10 Pro
Please reply to the forum so all may benefit.
Go to the top of the page
 
paccus
post Mar 5 2018, 05:17 AM
Post#4



Posts: 3
Joined: 2-March 18



My problem is to get a table structured as follows:

BGM...............DTM..............LIN............GIN.................Quantiy (=1 if the S.N. (GIN) is not null)
0089430043 05/02/2018 46550705 AL7B009435.......1
0089430043 05/02/2018 46550705 AL7B009438.......1
0089430043 05/02/2018 01182907 ...........................1
0089430043 05/02/2018 46361802 ...........................4
etc...
This post has been edited by paccus: Mar 5 2018, 05:18 AM
Go to the top of the page
 
zaxbat
post Mar 5 2018, 01:45 PM
Post#5



Posts: 1,184
Joined: 26-January 06
From: .....the wiregrass (either you know or you don't)


In your current non-working code you have 3 moveprevious attempts. Since that command does not exist on a line input file you will need to simply save the previous 3 records so that you can still access them. For instance.... have saverec1, saverec2, saverec3 as string.... at the bottom of your loop insert code like saverec3 = saverec 2....saverec2=saverec1....saverec1 = strtextline

In doing this....you will not need to moveprevious...you can simply reference saverec2 or saverec3 as appropriate. Do you see how this can work?

Where you have the movenext command you should be able to copy the recs again (saverec3 = saverec 2....saverec2=saverec1....saverec1 = strtextline) and then jump (goto) topofloop: label so the code will line input the next record....

That should get you close...think you will see how it works.

REVISION: after looking longer at your code...seems you only need last record or one previous record....so see my next post.
This post has been edited by zaxbat: Mar 5 2018, 02:35 PM

--------------------
Kindest regards, and Cheers!
ZAX

A picture is worth a thousand words and a zipped DB is worth a thousand pictures.
Oh, and....please don't disappear into the Twilight Zone.... Holler back with your results!
Go to the top of the page
 
zaxbat
post Mar 5 2018, 02:32 PM
Post#6



Posts: 1,184
Joined: 26-January 06
From: .....the wiregrass (either you know or you don't)


Think your code needs to look something like this....actually I got a bit lost with you logic and have not run this against your input...but it's closer to what you need...I'll work on it more later.

Additionally, seem you are still debugging this...noted that npac is not even used so far.


Public Function import1()

Dim strFilename As String: strFilename = "C:\despatch.txt"
Dim strTextLine, CodProd, DataDoc As String
Dim LastRec string
Dim SNarray() As String
Dim NumDoc As Long
Dim nPAC, NumRig, intCount As Integer
Dim iFile As Integer: iFile = FreeFile

Open strFilename For Input As #iFile

if NOT EOF(1) Then Line Input #1, strTextLine

Do Until EOF(1)
strTextLine = Replace(strTextLine, "'", "")

'BGM
If Left(strTextLine, 3) = "BGM" Then NumDoc = Mid(strTextLine, 9, 10)

'DTM
If Left(strTextLine, 6) = "DTM+11" Then DataDoc = Mid(strTextLine, 14, 2) & "/" & Mid(strTextLine, 12, 2) & "/" & Mid(strTextLine, 8, 4)

'CPS = numero record
If Left(strTextLine, 3) = "CPS" Then NumRig = Val(Mid(strTextLine, 5, 3))

'PAC = numero di matricole da estrarre
If Left(strTextLine, 3) = "PAC" Then nPAC = Val(Mid(strTextLine, 5, 3))

'GIN
If Left(strTextLine, 3) <> "GIN" Then ' if this is not GIN rec then keep processing else get next

'LIN
If Left(strTextLine, 3) = "LIN" Then CodProd = Mid(strTextLine, 8, 8)

''''''''strTextLine.MovePrevious
if LastRec <> null then
SNarray = Split(Mid(LastRec, 8), "+")

For intCount = LBound(SNarray) To UBound(SNarray)
Debug.Print NumDoc & " " & DataDoc & " " & NumRig & " " & CodProd & " " & SNarray(intCount)
Next
else
LastRec = strtextline
Line Input #1, strtextline
Endif
Loop

Close #iFile
End Function
This post has been edited by zaxbat: Mar 5 2018, 02:36 PM

--------------------
Kindest regards, and Cheers!
ZAX

A picture is worth a thousand words and a zipped DB is worth a thousand pictures.
Oh, and....please don't disappear into the Twilight Zone.... Holler back with your results!
Go to the top of the page
 
paccus
post Mar 6 2018, 04:00 AM
Post#7



Posts: 3
Joined: 2-March 18



Tank you ZaxBat but your code seems to be wrong...
Finally I solved (I really don't know how I did), here my code:

Public Function Importa()

Dim FSO As Object, objFile, objFolderIN, objFolderOUT As Object
Dim i As Integer
'Dim strFilename As String: strFilename = "C:\DESPATCH.txt"
Dim strTextLine, CodPro, DataDoc As String
Dim SNarray() As String

Dim NumDoc As Long
Dim nPAC, NumRig, intCount As Integer
Dim iFile As Integer: iFile = FreeFile

Set FSO = CreateObject("Scripting.FileSystemObject")
Set objFolderIN = FSO.GetFolder("C:\IN")
Set objFolderOUT = FSO.GetFolder("C:\Archivio")

i = 1
For Each objFile In objFolderIN.Files
If Right(objFile.Name, 3) = "txt" Then

DoCmd.SetWarnings False
DoCmd.OpenQuery "001: Svuota DESADV" 'empty the DESADV table
DoCmd.SetWarnings True

Open objFile For Input As #iFile

Do Until EOF(1)
Line Input #1, strTextLine
strTextLine = Replace(strTextLine, "'", "")

'BGM
If Left(strTextLine, 3) = "BGM" Then
NumDoc = Mid(strTextLine, 9, 10)
End If

'DTM
If Left(strTextLine, 6) = "DTM+11" Then
DataDoc = Mid(strTextLine, 14, 2) & "/" & Mid(strTextLine, 12, 2) & "/" & Mid(strTextLine, 8, 4)
End If

'CPS = numero record
If Left(strTextLine, 3) = "CPS" Then
NumRig = Val(Mid(strTextLine, 5, 3))
End If

'PAC = Qta
If Left(strTextLine, 3) = "PAC" Then
nPAC = Val(Mid(strTextLine, 5, 3))
End If

'LIN
If Left(strTextLine, 3) = "LIN" Then
CodPro = Mid(strTextLine, 8, 8)
Else
CodPro = ""
End If

DoCmd.SetWarnings False
DoCmd.RunSQL "INSERT INTO DESADV (Record, NumDoc, DataDoc, NumRiga, CodProd, Qta)" & "Values ('" & strTextLine & "', '" & NumDoc & "', '" & DataDoc & "', '" & NumRig & "', '" & CodPro & "', '" & nPAC & "');"
DoCmd.SetWarnings True

'GIN
If Left(strTextLine, 3) = "GIN" Then

SNarray = Split(Mid(strTextLine, 8), "+")

For intCount = LBound(SNarray) To UBound(SNarray)
'Debug.Print NumDoc & " " & DataDoc & " " & NumRig & " " & CodPro & " " & SNarray(intCount)

DoCmd.SetWarnings False
DoCmd.RunSQL "INSERT INTO DESADV (Record, NumDoc, DataDoc, NumRiga, NumSerie)" & "Values ('" & strTextLine & "', '" & NumDoc & "', '" & DataDoc & "', '" & NumRig & "', '" & SNarray(intCount) & "');"
DoCmd.SetWarnings True

Next
End If

Loop

Close #iFile

DoCmd.SetWarnings False
DoCmd.OpenQuery "002: Crea CodiceProdotto-LIN" 'This is a simple query to get a table containing CPS (Row Number) and his relative MaxOfCodProd
DoCmd.OpenQuery "010: Aggiorna CodiceProdotto su DESADV" 'This query update all the records that didn't get before the CPS number
DoCmd.SetWarnings True

Else
'esce
MsgBox ("File non di testo")
End If

'Archive just processed file
Name objFolderIN & "\" & objFile.Name As objFolderOUT & "\" & objFile.Name

i = i + 1
Next objFile

' Empty variables
Set objFile = Nothing
Set objFolderIN = Nothing
Set objFolderOUT = Nothing
Set FSO = Nothing

End Function
Go to the top of the page
 


Custom Search
RSSSearch   Top   Lo-Fi    24th September 2018 - 04:31 AM