'This is just an example to show how to translate a UN/EDIFACT INVOIC in VB6 using the Framework EDI component
Option Explicit
Private oEdiDoc As Fredi.ediDocument
Private oSegment As Fredi.ediDataSegment
Private oSchemas As Fredi.ediSchemas
Private Sub cmdTranslate_Click()
Dim sSefFile As String
Dim sEdiFile As String
Dim sSegmentID As String
Dim nArea As Integer
Dim sLoopSection As String
Dim sPath As String
Dim sAllowanceQlfr As String
Dim sPartyQlfr As String
Dim sValue As String
Me.MousePointer = vbHourglass
cmdTranslate.Enabled = False
sPath = Trim(App.Path) & "\"
sSefFile = "INVOIC_S93A.SEF"
sEdiFile = "INVOIC.TXT"
'instantiate edi document object
Set oEdiDoc = New Fredi.ediDocument
'THIS MAKES CERTAIN THAT FREDI ONLY USES THE SEF FILE PROVIDED, AND THAT IT DOES
'NOT USE ITS BUILT-IN STANDARD REFERENCE TABLE TO GENERATE THE EDI FILE.
Set oSchemas = oEdiDoc.GetSchemas
oSchemas.EnableStandardReference = False
'THIS OPTIONS STOPS FREDI FROM KEEPING ALL THE SEGMENTS IN MEMORY
oEdiDoc.CursorType = Cursor_ForwardOnly
'if UNA segment does not exist, then use following terminators
oEdiDoc.SegmentTerminator = "'"
oEdiDoc.ElementTerminator = "+"
oEdiDoc.CompositeTerminator = ":"
oEdiDoc.ReleaseIndicator = "?"
'LOADS THE SEF FILE
oEdiDoc.LoadSchema sPath & sSefFile, 0
'LOADS THE EDI FILE
oEdiDoc.LoadEdi sPath & sEdiFile
'GETS THE FIRST DATA SEGMENT
Set oSegment = oEdiDoc.FirstDataSegment
'LOOP THAT WILL TRAVERSE THRU EDI FILE FROM TOP TO BOTTOM
Do While Not oSegment Is Nothing
'DATA SEGMENTS ARE IDENTIFIED BY THEIR ID, THE LOOP SECTION AND AREA
'(OR TABLE) NUMBER THAT THEY ARE IN.
sSegmentID = oSegment.ID
sLoopSection = oSegment.LoopSection
nArea = oSegment.Area
If nArea = 0 Then
If sLoopSection = "" Then
If sSegmentID = "UNB" Then
txtPartnerID.Text = oSegment.DataElementValue(2, 1) 'composite element 2, subelement 1
txtSiteCode.Text = oSegment.DataElementValue(3, 3) 'composite element 3, subelement 3
txtTransmitDate.Text = StringToDate6(oSegment.DataElementValue(4, 1)) 'composite element 4, subelement 1
txtTransmitTime.Text = oSegment.DataElementValue(4, 2) 'composite element 4, subelement 2
End If 'sSegmentID
End If 'sLoopSection
ElseIf nArea = 1 Then
If sLoopSection = "" Then
If sSegmentID = "UNH" Then
sValue = oSegment.DataElementValue(1) 'Message reference number
sValue = oSegment.DataElementValue(2, 1) 'Message type identifier
sValue = oSegment.DataElementValue(2, 2) 'Message version number
sValue = oSegment.DataElementValue(2, 3) 'Message release number
sValue = oSegment.DataElementValue(2, 4) 'Controlling agency
sValue = oSegment.DataElementValue(2, 5) 'Association assigned code
ElseIf sSegmentID = "BGM" Then
sValue = oSegment.DataElementValue(1, 1) 'Document/message name, coded
sValue = oSegment.DataElementValue(1, 2) 'Code list qualifier
sValue = oSegment.DataElementValue(1, 3) 'Code list responsible agency, coded
sValue = oSegment.DataElementValue(1, 4) 'Document/message name
txtInvoiceNo.Text = oSegment.DataElementValue(2) 'Document/message name
sValue = oSegment.DataElementValue(3) 'Document/message name
ElseIf sSegmentID = "DTM" Then
sValue = oSegment.DataElementValue(1, 1) 'Date/time/period qualifier
txtInvDate.Text = oSegment.DataElementValue(1, 2) 'Date/time/period
sValue = oSegment.DataElementValue(1, 3) 'Date/time/period format qualifier
End If 'SegmentID
ElseIf sLoopSection = "RFF" Then
If sSegmentID = "RFF" Then
txtOrderNo.Text = oSegment.DataElementValue(1, 2)
End If 'SegmentID
ElseIf sLoopSection = "NAD" Then
If sSegmentID = "NAD" Then
sPartyQlfr = oSegment.DataElementValue(1)
End If
If sPartyQlfr = "RE" Then
If sSegmentID = "NAD" Then
sValue = oSegment.DataElementValue(1) 'Party qualifier
sValue = oSegment.DataElementValue(2, 1) 'Party identification
sValue = oSegment.DataElementValue(2, 2) 'Code list qualifier
sValue = oSegment.DataElementValue(2, 3) 'Code list responsible agency, coded
sValue = oSegment.DataElementValue(3, 1) 'Name and address line
sValue = oSegment.DataElementValue(3, 2) 'Name and address line
sValue = oSegment.DataElementValue(3, 3) 'Name and address line
sValue = oSegment.DataElementValue(3, 4) 'Name and address line
sValue = oSegment.DataElementValue(3, 5) 'Name and address line
txtManufacturerName.Text = oSegment.DataElementValue(4, 1) 'Party name
sValue = oSegment.DataElementValue(4, 2) 'Party name
sValue = oSegment.DataElementValue(4, 3) 'Party name
End If
ElseIf sPartyQlfr = "ST" Then
If sSegmentID = "NAD" Then
txtShipToName.Text = oSegment.DataElementValue(4, 1)
End If
ElseIf sPartyQlfr = "BY" Then
If sSegmentID = "NAD" Then
txtBuyerName.Text = oSegment.DataElementValue(4, 1)
End If
End If
ElseIf sLoopSection = "NAD;RFF" Then
If sSegmentID = "RFF" Then
If oSegment.DataElementValue(1, 1) = "VA" Then
txtManufRef.Text = oSegment.DataElementValue(1, 2)
End If
End If 'SegmentID
ElseIf sLoopSection = "NAD;CTA" Then
If sSegmentID = "CTA" Then
If oSegment.DataElementValue(1) = "AR" Then
txtARContact.Text = oSegment.DataElementValue(2, 2)
End If
ElseIf sSegmentID = "COM" Then
If oSegment.DataElementValue(1, 2) = "TE" Then
txtARTelephone.Text = oSegment.DataElementValue(1, 1)
End If
End If 'SegmentID
ElseIf sLoopSection = "CUX" Then
If sSegmentID = "CUX" Then
End If 'SegmentID
ElseIf sLoopSection = "ALC" Then
If sSegmentID = "ALC" Then
sAllowanceQlfr = oSegment.DataElementValue(1)
End If 'SegmentID
ElseIf sLoopSection = "ALC;PCD" Then
If sAllowanceQlfr = "C" Then
If sSegmentID = "PCD" Then
txtToolingPerc.Text = oSegment.DataElementValue(1, 1)
End If 'SegmentID
End If
ElseIf sLoopSection = "ALC;MOA" Then
If sAllowanceQlfr = "C" Then
If sSegmentID = "MOA" Then
txtToolingCharge.Text = oSegment.DataElementValue(1, 2)
End If 'sSegmentID
End If
End If 'sLoopSection
ElseIf nArea = 2 Then
If sLoopSection = "LIN" Then
If sSegmentID = "LIN" Then
txtLineNo.Text = oSegment.DataElementValue(1) 'Line item number
sValue = oSegment.DataElementValue(2) 'Action request/notification, coded
txtBuyerPartNo.Text = oSegment.DataElementValue(3, 1) 'Item number
sValue = oSegment.DataElementValue(3, 2) 'Item number type, coded
sValue = oSegment.DataElementValue(3, 3) 'Code list qualifier
sValue = oSegment.DataElementValue(3, 4) 'Code list responsible agency, coded
ElseIf sSegmentID = "QTY" Then
txtQty.Text = oSegment.DataElementValue(1, 2)
txtMeasure.Text = oSegment.DataElementValue(1, 3)
End If 'SegmentID
ElseIf sLoopSection = "LIN;PRI" Then
If sSegmentID = "PRI" Then
txtItemPrice.Text = oSegment.DataElementValue(1, 2)
End If 'sSegmentID
End If 'sLoopSection
ElseIf nArea = 3 Then
If sLoopSection = "" Then
If sSegmentID = "UNS" Then
End If 'SegmentID
ElseIf sLoopSection = "MOA" Then
If sSegmentID = "MOA" Then
sValue = oSegment.DataElementValue(1, 1) 'Monetary amount type qualifier
txtTotalAmnt.Text = oSegment.DataElementValue(1, 2) 'Monetary amount
sValue = oSegment.DataElementValue(1, 3) 'Currency, coded
sValue = oSegment.DataElementValue(1, 4) 'Currency qualifier
sValue = oSegment.DataElementValue(1, 5) 'Status, coded
End If 'SegmentID
ElseIf sLoopSection = "TAX" Then
If sSegmentID = "TAX" Then
sValue = oSegment.DataElementValue(1) 'Duty/tax/fee function qualifier
sValue = oSegment.DataElementValue(2, 1) 'Duty/tax/fee type, coded
sValue = oSegment.DataElementValue(2, 2) 'Code list qualifier
sValue = oSegment.DataElementValue(2, 3) 'Code list responsible agency, coded
sValue = oSegment.DataElementValue(2, 4) 'Duty/tax/fee type
sValue = oSegment.DataElementValue(3, 1) 'Duty/tax/fee account identification
sValue = oSegment.DataElementValue(3, 2) 'Code list qualifier
sValue = oSegment.DataElementValue(3, 3) 'Code list responsible agency, coded
sValue = oSegment.DataElementValue(4) 'Duty/tax/fee assessment basis
sValue = oSegment.DataElementValue(5, 1) 'Duty/tax/fee rate identification
sValue = oSegment.DataElementValue(5, 2) 'Code list qualifier
sValue = oSegment.DataElementValue(5, 3) 'Code list responsible agency, coded
txtTaxRate.Text = oSegment.DataElementValue(5, 4) 'Duty/tax/fee rate
sValue = oSegment.DataElementValue(5, 5) 'Duty/tax/fee rate basis identification
sValue = oSegment.DataElementValue(5, 6) 'Code list qualifier
sValue = oSegment.DataElementValue(5, 7) 'Code list responsible agency, coded
sValue = oSegment.DataElementValue(6) 'Duty/tax/fee category, coded
ElseIf sSegmentID = "MOA" Then
txtTaxAmount.Text = oSegment.DataElementValue(1, 2)
End If 'sSegmentID
End If 'sLoopSection
End If 'nArea
'GETS THE NEXT DATA SEGMENT
Set oSegment = oSegment.Next
Loop
'DESTROY OBJECTS
Set oEdiDoc = Nothing
Set oSchemas = Nothing
Set oSegment = Nothing
Me.MousePointer = vbNormal
End Sub
