我需要将此EDI文本文件导入Access表('作为行终止符):
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'
这是我需要的结果:
0089430043 05/02/2018 46550705 AL7B009435
0089430043 05/02/2018 46550705 AL7B009438
等...
这就是我试过的:
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
在使用序列号导入GIN记录之前,我需要使用che产品代码来实现LIN记录,然后将它们传递给变量。 我已尝试使用.MoveNext,然后使用两个.MovePrevious,但它给了我错误:需要对象。
任何帮助将不胜感激。 感谢。
答案 0 :(得分:0)
最后我解决了(我真的不知道我是怎么做的),这里是我的代码:
Function GetLine() As String()
Dim FSO As Object, objFile, objFolderIN, objFolderOUT As Object
Set FSO = CreateObject("Scripting.FileSystemObject")
Set objFolderIN = FSO.GetFolder("C:\IN")
Set objFolderOUT = FSO.GetFolder("C:\Archivio")
Dim data, elem, comp
Dim i As Integer
Dim iFile As Integer: iFile = FreeFile
Dim Elements(99, 3) As String
Dim mychar As String
Dim NumDoc As Long
i = 1
For Each objFile In objFolderIN.Files
Open objFile For Input As #iFile
Do Until EOF(1)
Line Input #1, data
'Debug.Print data
mychar = Input(1, #1) ' Get one character.
If mychar = "'" Then Exit Do ' End of Segment
If mychar = vbCr Or _
mychar = vbLf Then
'Continue
ElseIf mychar = "?" Then
mychar = Input(1, #1) ' Skip Line Breaks and Escape
data = data & mychar
ElseIf mychar = "'" Then
Exit Do
ElseIf mychar = "+" Then ' Element separator
Elements(elem, comp) = data
data = ""
comp = 1
elem = elem + 1
ElseIf mychar = ":" Then ' Composite separator
Elements(elem, comp) = data
data = ""
comp = comp + 1
Else ' Regular data
data = data & mychar
End If
Loop
Elements(elem, comp) = data
GetLine = Elements
Close #iFile
i = i + 1
Next objFile
'BGM
If Elements(0, 0) = "BGM" Then
NumDoc = Elements(2, 1)
Debug.Print NumDoc
End If
End Function
答案 1 :(得分:0)
这是一个解析EDIFACT段的函数示例,它没有被调试,但它显示了读取EDI数据的算法。它可以很容易地适应读取ANSI X12。
Function GetLine() as String()
Dim Elements as String(99,3)
Do Until EOF(1)
mychar = Input(1, #1) ' Get one character
If mychar = vbCr Or \
mychar = vbLf Then ' Skip Line Breaks
Continue
Else If mychar = "?" Then ' Process Escape
If EOF(1) Then Exit Do ' Reached end of file
mychar = Input(1, #1)
data = data & mychar ' Treat next char as regular
Else If mychar = "'" Then ' End of Segment
Exit Do
Else If mychar = "+" Then ' Element separator
Elements(Elem,Comp) = data
data = ""
Comp = 1
Elem = Elem + 1
Else If mychar = ":" Then ' Composite separator
Elements(Elem,Comp) = data
data = ""
Comp = Comp + 1
Else ' Regular data
data = data & mychar
End If
Loop
Elements(Elem,Comp) = data
GetLine = Elements
End Function
使用示例
'BGM
If Elements(0,0) = "BGM" Then
NumDoc = Elements(2,1)
End If