'This is just an example program to show how to translate an EDI X12 856 file in Visual Basic 6 'with Framework EDI component Option Explicit Private oEdiDoc As Fredi.ediDocument Private oSchema As Fredi.ediSchema Private oSchemas As Fredi.ediSchemas Private oSegment As Fredi.ediDataSegment Private oElement As Fredi.ediDataElement Private Sub cmdTranslate_Click() Dim i As Integer Dim nCount As Integer Dim sPath As String Dim sEntity As String Dim nIndex As Integer Dim sSefFile As String Dim sEdiFile As String Dim iIndex As Integer Dim sHLevel As String Dim nArea As Integer Dim sLoopSection As String Dim sSegmentID As String Dim sValue As String Me.MousePointer = vbHourglass sPath = Trim(App.Path) & "\" sSefFile = "856_X12-4010.SEF" sEdiFile = "856Output.x12" 'instantiate edi document object Set oEdiDoc = New Fredi.ediDocument 'This option stops FREDI from loading all the segments into memory. Improves performance oEdiDoc.CursorType = Cursor_ForwardOnly 'disable internal standard reference library to make certain sef is used for schema. Improves performance Set oSchemas = oEdiDoc.GetSchemas oSchemas.EnableStandardReference = False 'load Sef file oEdiDoc.ImportSchema sPath & sSefFile, 0 'load edi file oEdiDoc.LoadEdi sPath & sEdiFile 'traverse through all segments sequentially of the edi file 'get first data segment of edi file Set oSegment = oEdiDoc.FirstDataSegment While Not oSegment Is Nothing 'identify each segment by its area, loop secction it is in, and its segment id '(To better understand the properties of the segments, view the sample edi file with our eFileManager utility) nArea = oSegment.Area sLoopSection = oSegment.LoopSection sSegmentID = oSegment.ID If nArea = 0 Then 'envelope segments such as ISA and GS have no area number If sSegmentID = "ISA" Then 'map ISA data elements here sValue = oSegment.DataElementValue(13) 'Interchange Control Number ElseIf sSegmentID = "GS" Then 'map GS data elements here sValue = oSegment.DataElementValue(6) 'Group Control Number End If ElseIf nArea = 1 Then If sLoopSection = "" Then If sSegmentID = "ST" Then iIndex = 0 sValue = oSegment.DataElementValue(2) 'Transaction Set Control Number ElseIf sSegmentID = "BSN" Then txtShipmentNo.Text = oSegment.DataElementValue(2) 'Shipment Identification End If End If ElseIf nArea = 2 Then If sLoopSection = "HL" And sSegmentID = "HL" Then sHLevel = oSegment.DataElementValue(3) 'Get HL level entity End If If sHLevel = "S" Then 'SHIPMENT If sLoopSection = "HL" Then If sSegmentID = "TD1" Then If oSegment.DataElementValue(1) = "TKT" Then txtTotalQty.Text = oSegment.DataElementValue(2) txtTotalWeight.Text = oSegment.DataElementValue(7) End If ElseIf sSegmentID = "TD5" Then txtRoutingCode.Text = oSegment.DataElementValue(3) txtRoutingDesc.Text = oSegment.DataElementValue(5) ElseIf sSegmentID = "TD3" Then txtEquipCode.Text = oSegment.DataElementValue(1) txtEquipInitial.Text = oSegment.DataElementValue(2) txtEquipNo.Text = oSegment.DataElementValue(3) ElseIf sSegmentID = "DTM" Then If oSegment.DataElementValue(1) = "011" Then 'Shipped date txtShippedDate.Text = oSegment.DataElementValue(2) ElseIf oSegment.DataElementValue(1) = "017" Then 'Estimated delivery date txtEstDeliveryDate.Text = oSegment.DataElementValue(2) End If ElseIf sSegmentID = "REF" Then If oSegment.DataElementValue(1) = "BM" Then txtBOLNo.Text = oSegment.DataElementValue(2) End If End If ElseIf sLoopSection = "HL;N1" Then If sSegmentID = "N1" Then sEntity = oSegment.DataElementValue(1) End If If sEntity = "BT" Then If sSegmentID = "N1" Then txtBillToName.Text = oSegment.DataElementValue(2) txtBillToDUNS.Text = oSegment.DataElementValue(4) ElseIf sSegmentID = "N3" Then txtBillToAddress.Text = oSegment.DataElementValue(1) ElseIf sSegmentID = "N4" Then txtBillToCity.Text = oSegment.DataElementValue(1) txtBillToState.Text = oSegment.DataElementValue(2) txtBillToZip.Text = oSegment.DataElementValue(3) End If ElseIf sEntity = "ST" Then If sSegmentID = "N1" Then txtShipToName.Text = oSegment.DataElementValue(2) txtShipToDUNS.Text = oSegment.DataElementValue(4) ElseIf sSegmentID = "N3" Then txtShipToAddress.Text = oSegment.DataElementValue(1) ElseIf sSegmentID = "N4" Then txtShipToCity.Text = oSegment.DataElementValue(1) txtShipToState.Text = oSegment.DataElementValue(2) txtShipToZip.Text = oSegment.DataElementValue(3) End If End If End If 'sLoopsection ElseIf sHLevel = "O" Then 'ORDER If sLoopSection = "HL" Then If sSegmentID = "PRF" Then txtPONumber.Text = oSegment.DataElementValue(1) txtReleaseNo.Text = oSegment.DataElementValue(2) txtPODate.Text = oSegment.DataElementValue(4) ElseIf sSegmentID = "REF" Then If oSegment.DataElementValue(1) = "IV" Then txtInvoiceNo.Text = oSegment.DataElementValue(2) End If End If End If ElseIf sHLevel = "I" Then 'ITEMS If sLoopSection = "HL" Then If sSegmentID = "LIN" Then txtEAN(iIndex).Text = oSegment.DataElementValue(3) ElseIf sSegmentID = "SN1" Then txtQtyShipped(iIndex).Text = oSegment.DataElementValue(2) txtUnit(iIndex).Text = oSegment.DataElementValue(3) txtQty(iIndex).Text = oSegment.DataElementValue(5) txtUnit(iIndex).Text = oSegment.DataElementValue(6) txtStatusCode(iIndex).Text = oSegment.DataElementValue(8) ElseIf sSegmentID = "PRF" Then txtPONumber.Text = oSegment.DataElementValue(1) txtReleaseNo.Text = oSegment.DataElementValue(2) txtPODate.Text = oSegment.DataElementValue(4) ElseIf sSegmentID = "PID" Then If oSegment.DataElementValue(1) = "F" Then txtDescription(iIndex).Text = oSegment.DataElementValue(5) End If iIndex = iIndex + 1 End If End If End If ElseIf nArea = 3 Then End If Set oSegment = oSegment.Next Wend Me.MousePointer = vbNormal MsgBox ("Done") cmdTranslate.Enabled = False End Sub