'This is just an example program to show how to generate 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 oInterchange As Fredi.ediInterchange
Private oGroup As Fredi.ediGroup
Private oTransactionset As Fredi.ediTransactionSet
Private oSegment As Fredi.ediDataSegment
Private sSefFile As String
Private sEdiFile As String
Private Sub cmdGenerate_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 nInstance As Integer
Dim iItemCount As Integer
Dim nTotalQty As Double
Dim nTotalWeight As Double
Dim nShipmentCounter As Integer
Dim nShipments As Integer
Dim nOrderCounter As Integer
Dim nOrders As Integer
Dim nItemCounter As Integer
Dim nItems As Integer
Dim nHlCounter As Integer
Dim nHlShipmentParent As Integer
Dim nHlOrderParent As Integer
Dim nHlItemParent As Integer
Me.MousePointer = vbHourglass
sPath = App.Path & "\"
sSefFile = "856_X12-4010.sef"
sEdiFile = "856OUTPUT.x12"
'instantiate edi document object
Set oEdiDoc = New Fredi.ediDocument
'change cursor type to forwardwrite to improve performance
oEdiDoc.CursorType = Cursor_ForwardWrite
'disable internal standard reference library to make certian SEF file is used
Set oSchemas = oEdiDoc.GetSchemas
oSchemas.EnableStandardReference = False
'load sef file
Set oSchema = oEdiDoc.ImportSchema(sPath & sSefFile, 0)
'set terminators
oEdiDoc.SegmentTerminator = "~" & vbCrLf
oEdiDoc.ElementTerminator = "*"
oEdiDoc.CompositeTerminator = ">"
'create ISA segment
Set oInterchange = oEdiDoc.CreateInterchange("X", "004010")
Set oSegment = oInterchange.GetDataSegmentHeader
oSegment.DataElementValue(1) = "00"
oSegment.DataElementValue(3) = "00"
oSegment.DataElementValue(5) = "14"
oSegment.DataElementValue(6) = "0073268795005"
oSegment.DataElementValue(7) = "ZZ"
oSegment.DataElementValue(8) = "RECEIVERISA"
oSegment.DataElementValue(9) = "960807"
oSegment.DataElementValue(10) = "1548"
oSegment.DataElementValue(11) = "U"
oSegment.DataElementValue(12) = "00401"
oSegment.DataElementValue(13) = "000000020"
oSegment.DataElementValue(14) = "0"
oSegment.DataElementValue(15) = "T"
oSegment.DataElementValue(16) = ">"
'create GS segment
Set oGroup = oInterchange.CreateGroup("004010")
Set oSegment = oGroup.GetDataSegmentHeader
oSegment.DataElementValue(1) = "SH"
oSegment.DataElementValue(2) = "007326879"
oSegment.DataElementValue(3) = "RECEIVERGS"
oSegment.DataElementValue(4) = "19960807"
oSegment.DataElementValue(5) = "1548"
oSegment.DataElementValue(6) = "1"
oSegment.DataElementValue(7) = "X"
oSegment.DataElementValue(8) = "004010"
'create ST segment
Set oTransactionset = oGroup.CreateTransactionSet("856")
Set oSegment = oTransactionset.GetDataSegmentHeader
oSegment.DataElementValue(1) = "856"
oSegment.DataElementValue(2) = "00001"
'create BSN segment
Set oSegment = oTransactionset.CreateDataSegment("BSN")
oSegment.DataElementValue(1) = "00"
oSegment.DataElementValue(2) = txtShipmentNo.Text
oSegment.DataElementValue(3) = "20020301"
oSegment.DataElementValue(4) = "1340"
oSegment.DataElementValue(5) = "0002"
'hypothetical numbers of shipments, orders and items
nShipmentCounter = 1
nShipments = 1
nOrderCounter = 1
nOrders = 1
nItemCounter = 1
nItems = 6
'********************************************************************************************
'HL - HIERARCHICAL LEVEL - SHIPMENTS ********************************************************
Do While nShipmentCounter <= nShipments
nHlCounter = nHlCounter + 1
nHlOrderParent = nHlCounter
Set oSegment = oTransactionset.CreateDataSegment("HL\HL")
oSegment.DataElementValue(1) = nHlCounter
oSegment.DataElementValue(2) = ""
oSegment.DataElementValue(3) = "S"
oSegment.DataElementValue(4) = "1"
nTotalQty = 0
nTotalWeight = 0
For i = 0 To 7
If Len(Trim(txtCatalogNo(i).Text)) > 0 Then
nTotalQty = nTotalQty + Val(txtQty(i).Text)
nTotalWeight = nTotalWeight + Val(txtWeights(i).Text)
End If
Next
Set oSegment = oTransactionset.CreateDataSegment("HL\TD1")
oSegment.DataElementValue(1) = "TKT"
oSegment.DataElementValue(2) = nTotalQty
oSegment.DataElementValue(6) = "A3"
oSegment.DataElementValue(7) = nTotalWeight
oSegment.DataElementValue(8) = "01"
Set oSegment = oTransactionset.CreateDataSegment("HL\TD5")
oSegment.DataElementValue(2) = 2
oSegment.DataElementValue(3) = txtRoutingCode.Text
oSegment.DataElementValue(4) = "M"
oSegment.DataElementValue(5) = txtRoutingDesc.Text
Set oSegment = oTransactionset.CreateDataSegment("HL\TD3")
oSegment.DataElementValue(1) = txtEquipCode.Text
oSegment.DataElementValue(2) = txtEquipInitial.Text
oSegment.DataElementValue(3) = txtEquipNo.Text
Set oSegment = oTransactionset.CreateDataSegment("HL\REF")
oSegment.DataElementValue(1) = "BM"
oSegment.DataElementValue(2) = txtBOLNo.Text
Set oSegment = oTransactionset.CreateDataSegment("HL\DTM")
oSegment.DataElementValue(1) = "011"
oSegment.DataElementValue(2) = Format(txtShippedDate.Text, "YYYYMMDD")
Set oSegment = oTransactionset.CreateDataSegment("HL\DTM(2)")
oSegment.DataElementValue(1) = "017"
oSegment.DataElementValue(2) = Format(txtEstDeliveryDate.Text, "YYYYMMDD")
'Bill To address information
Set oSegment = oTransactionset.CreateDataSegment("HL\N1\N1")
oSegment.DataElementValue(1) = "BT"
oSegment.DataElementValue(2) = txtBillToName.Text
oSegment.DataElementValue(3) = "1"
oSegment.DataElementValue(4) = txtBillToDUNS.Text
Set oSegment = oTransactionset.CreateDataSegment("HL\N1\N3")
oSegment.DataElementValue(1) = txtBillToAddress.Text
Set oSegment = oTransactionset.CreateDataSegment("HL\N1\N4")
oSegment.DataElementValue(1) = txtBillToCity.Text
oSegment.DataElementValue(2) = txtBillToState.Text
oSegment.DataElementValue(3) = txtBillToZip.Text
'Ship-To address information
Set oSegment = oTransactionset.CreateDataSegment("HL\N1(2)\N1") 'Note: it is not necessary to include the loop instance counter (2) in the syntx when cursor type is set to forwardwrite
oSegment.DataElementValue(1) = "ST"
oSegment.DataElementValue(2) = txtShipToName.Text
oSegment.DataElementValue(3) = "1"
oSegment.DataElementValue(4) = txtShipToDUNS.Text
Set oSegment = oTransactionset.CreateDataSegment("HL\N1(2)\N3")
oSegment.DataElementValue(1) = txtShipToAddress.Text
Set oSegment = oTransactionset.CreateDataSegment("HL\N1(2)\N4")
oSegment.DataElementValue(1) = txtShipToCity.Text
oSegment.DataElementValue(2) = txtShipToState.Text
oSegment.DataElementValue(3) = txtShipToZip.Text
'********************************************************************************************
'HL - HIERARCHICAL LEVEL - ORDER ************************************************************
Do While nOrderCounter <= nOrders
nHlCounter = nHlCounter + 1
nHlItemParent = nHlCounter
Set oSegment = oTransactionset.CreateDataSegment("HL\HL")
oSegment.DataElementValue(1) = nHlCounter
oSegment.DataElementValue(2) = nHlOrderParent
oSegment.DataElementValue(3) = "O"
oSegment.DataElementValue(4) = "1"
Set oSegment = oTransactionset.CreateDataSegment("HL\PRF")
oSegment.DataElementValue(1) = txtPONumber.Text
oSegment.DataElementValue(2) = txtReleaseNo.Text
oSegment.DataElementValue(3) = ""
oSegment.DataElementValue(4) = Format(txtPODate.Text, "YYYYMMDD")
Set oSegment = oTransactionset.CreateDataSegment("HL\REF")
oSegment.DataElementValue(1) = "IV"
oSegment.DataElementValue(2) = txtInvoiceNo.Text
Set oSegment = oTransactionset.CreateDataSegment("HL\FOB")
oSegment.DataElementValue(1) = "PS"
oSegment.DataElementValue(2) = "DE"
oSegment.DataElementValue(3) = ""
'********************************************************************************************
'HL - HIERARCHICAL LEVEL - ITEMS ************************************************************
Do While nItemCounter <= nItems
nHlCounter = nHlCounter + 1
Set oSegment = oTransactionset.CreateDataSegment("HL\HL")
oSegment.DataElementValue(1) = nHlCounter
oSegment.DataElementValue(2) = nHlItemParent
oSegment.DataElementValue(3) = "I"
oSegment.DataElementValue(4) = "0"
Set oSegment = oTransactionset.CreateDataSegment("HL\LIN")
oSegment.DataElementValue(1) = nItemCounter
oSegment.DataElementValue(2) = "UA"
oSegment.DataElementValue(3) = txtEAN(nItemCounter - 1).Text
Set oSegment = oTransactionset.CreateDataSegment("HL\SN1")
oSegment.DataElementValue(2) = txtQtyShipped(nItemCounter - 1).Text
oSegment.DataElementValue(3) = txtUnit(nItemCounter - 1).Text
oSegment.DataElementValue(5) = txtQty(nItemCounter - 1).Text
oSegment.DataElementValue(6) = txtUnit(nItemCounter - 1).Text
oSegment.DataElementValue(8) = txtStatusCode(nItemCounter - 1).Text
Set oSegment = oTransactionset.CreateDataSegment("HL\PRF")
oSegment.DataElementValue(1) = txtPONumber.Text
oSegment.DataElementValue(2) = txtReleaseNo.Text
oSegment.DataElementValue(3) = ""
oSegment.DataElementValue(4) = Format(txtPODate.Text, "YYYYMMDD")
Set oSegment = oTransactionset.CreateDataSegment("HL\PID")
oSegment.DataElementValue(1) = "F"
oSegment.DataElementValue(5) = txtDescription(nItemCounter - 1).Text
nItemCounter = nItemCounter + 1 'increment nItemCounter
Loop 'nItemCounter
nOrderCounter = nOrderCounter + 1 'increment nOrderCounter
Loop 'nOrderCounter
nShipmentCounter = nShipmentCounter + 1 'increment nShipmentCounter
Loop 'Shipment
'CTT - TRANSACTION TOTALS
Set oSegment = oTransactionset.CreateDataSegment("CTT")
oSegment.DataElementValue(1) = nItems 'Number of Line Items
'save edi object to file
oEdiDoc.Save sPath & sEdiFile
Me.MousePointer = vbNormal
MsgBox ("Done. Output = " & sPath & sEdiFile)
cmdGenerate.Enabled = False
End Sub
