将EDI文件逐行导入Access

Question

我需要将此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 但它给了我错误：需要对象。

任何帮助将不胜感激。 谢谢。

Answer 1

这是一个解析 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

Answer 2

最后我解决了（我真的不知道我是怎么做到的），这里是我的代码：

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