Source code for generating an EDI X12 850 in Access VB Script with the Framework EDI component

Private Sub Command0_Click()
    Dim oEdiDoc As Fredi.ediDocument
    Dim oSchema As Fredi.ediSchema
    Dim oInterchange As Fredi.ediInterchange
    Dim oGroup As Fredi.ediGroup
    Dim oTransactionset As Fredi.ediTransactionSet
    Dim oSegment As Fredi.ediDataSegment
    
    Dim oConn As ADODB.Connection
    Dim oRsInterchange As ADODB.Recordset
    Dim oRsGroup As ADODB.Recordset
    Dim oRsTransactionSet As ADODB.Recordset
    Dim oRsPOMaster As ADODB.Recordset
    Dim oRsPODetail As ADODB.Recordset
    Dim sConn As String
    
    Dim sSefFile As String
    Dim sEdiFile As String
    Dim sPath As String

    Dim i As Integer
    Dim nCount As Integer
    Dim sEntity As String
    Dim nIndex As Integer
    Dim iItemCount As Integer
    Dim nInstance  As Integer
    
    
    sPath = CurrentProject.Path & "\"
    
    sConn = "Provider=Microsoft.Jet.OLEDB.4.0; Data Source=" & sPath & "gen850.mdb"
    Set oConn = New ADODB.Connection
    oConn.Open sConn

    'The InterchangeIndex table contains information of Interchange.
    Set oRsInterchange = New ADODB.Recordset
    
    'The GroupIndex table contains information of the Functional Group.
    Set oRsGroup = New ADODB.Recordset
    
    'The TransactionSetIndex table contains information of the Transaction Sets in the
    'Interchanges
    Set oRsTransactionSet = New ADODB.Recordset
    
    'The POMaster table contains information of the Purchase Order in the Transaction Set
    Set oRsPOMaster = New ADODB.Recordset
    
    'The PODetail table contains information of the detailed items of Purchase Orders
    Set oRsPODetail = New ADODB.Recordset
    
    sSefFile = sPath & "850_4010.EVAL0.sef" 'EVALUATION SEF FILE
    sEdiFile = sPath & "850OUTPUT.x12"
    
    Set oEdiDoc = CreateObject("Fredi.ediDocument")
    Set oSchema = oEdiDoc.LoadSchema(sSefFile, 0)
    
    oEdiDoc.SegmentTerminator = "~" & vbCrLf
    oEdiDoc.ElementTerminator = "*"
    oEdiDoc.CompositeTerminator = ">"
    
    oRsInterchange.Open "Select * from InterchangeIndex", oConn, adOpenDynamic, adLockOptimistic
    Do While Not oRsInterchange.EOF
        Set oInterchange = oEdiDoc.CreateInterchange("X", "004010")
        Set oSegment = oInterchange.GetDataSegmentHeader
        oSegment.DataElementValue(1) = "00"
        oSegment.DataElementValue(3) = "00"
        oSegment.DataElementValue(5) = oRsInterchange("SenderID_Qlfr").Value
        oSegment.DataElementValue(6) = oRsInterchange("SenderID").Value
        oSegment.DataElementValue(7) = oRsInterchange("ReceiverID_Qlfr").Value
        oSegment.DataElementValue(8) = oRsInterchange("ReceiverID").Value
        oSegment.DataElementValue(9) = "960807"
        oSegment.DataElementValue(10) = "1548"
        oSegment.DataElementValue(11) = "U"
        oSegment.DataElementValue(12) = oRsInterchange("Version").Value
        oSegment.DataElementValue(13) = oRsInterchange("InterchangeControlNo").Value
        oSegment.DataElementValue(14) = "0"
        oSegment.DataElementValue(15) = "T"
        oSegment.DataElementValue(16) = ">"
        
        oRsGroup.Open "Select * from GroupIndex where InterchangeKey = " & oRsInterchange("InterchangeKey").Value, oConn, adOpenDynamic, adLockOptimistic
        Do While Not oRsGroup.EOF
            Set oGroup = oInterchange.CreateGroup("004010")
            Set oSegment = oGroup.GetDataSegmentHeader
            oSegment.DataElementValue(1) = oRsGroup("FunctionalIdCode").Value
            oSegment.DataElementValue(2) = oRsGroup("SenderDept").Value
            oSegment.DataElementValue(3) = oRsGroup("ReceiverDept").Value
            oSegment.DataElementValue(4) = "19960807"
            oSegment.DataElementValue(5) = "1548"
            oSegment.DataElementValue(6) = oRsGroup("GroupNo").Value
            oSegment.DataElementValue(7) = "X"
            oSegment.DataElementValue(8) = oRsGroup("Version").Value
        
            oRsTransactionSet.Open "Select * from TransactionSetIndex where GroupKey = " & oRsGroup("GroupKey").Value, oConn, adOpenDynamic, adLockOptimistic
            Do While Not oRsTransactionSet.EOF
                Set oTransactionset = oGroup.CreateTransactionSet("850")
                Set oSegment = oTransactionset.GetDataSegmentHeader
                oSegment.DataElementValue(2) = oRsTransactionSet("TransactionSetControlNo").Value
                
                oRsPOMaster.Open "Select * from POMaster where TsKey = " & oRsTransactionSet("TsKey").Value, oConn, adOpenDynamic, adLockOptimistic
                Do While Not oRsPOMaster.EOF
                    Set oSegment = oTransactionset.CreateDataSegment("BEG")
                    oSegment.DataElementValue(1) = "00"
                    oSegment.DataElementValue(2) = "SA"
                    oSegment.DataElementValue(3) = oRsPOMaster("PONumber").Value
                    oSegment.DataElementValue(5) = Format(oRsPOMaster("PODate").Value, "YYYYMMDD")

                    Set oSegment = oTransactionset.CreateDataSegment("REF")
                    oSegment.DataElementValue(1) = "VR"
                    oSegment.DataElementValue(2) = oRsPOMaster("VendorIDNo").Value

                    Set oSegment = oTransactionset.CreateDataSegment("ITD")
                    oSegment.DataElementValue(1) = "01"
                    oSegment.DataElementValue(2) = "3"
                    oSegment.DataElementValue(3) = oRsPOMaster("DiscountPerc").Value
                    oSegment.DataElementValue(5) = oRsPOMaster("DiscountDaysDue").Value
                    oSegment.DataElementValue(7) = oRsPOMaster("NetDays").Value

                    Set oSegment = oTransactionset.CreateDataSegment("DTM")
                    oSegment.DataElementValue(1) = "002"
                    oSegment.DataElementValue(2) = Format(oRsPOMaster("DeliveryDate").Value, "YYYYMMDD")
                    
                    'BILL TO
                    Set oSegment = oTransactionset.CreateDataSegment("N1\N1")
                    oSegment.DataElementValue(1) = "BT"
                    oSegment.DataElementValue(2) = oRsPOMaster("BillToName").Value
                    oSegment.DataElementValue(3) = "9"
                    oSegment.DataElementValue(4) = oRsPOMaster("BillToID").Value
                    
                    Set oSegment = oTransactionset.CreateDataSegment("N1\N3")
                    oSegment.DataElementValue(1) = oRsPOMaster("BillToAddress").Value
                    
                    Set oSegment = oTransactionset.CreateDataSegment("N1\N4")
                    oSegment.DataElementValue(1) = oRsPOMaster("BillToCity").Value
                    oSegment.DataElementValue(2) = oRsPOMaster("BillToState").Value
                    oSegment.DataElementValue(3) = oRsPOMaster("BillToZip").Value

                    'SHIP TO
                    Set oSegment = oTransactionset.CreateDataSegment("N1(2)\N1")
                    oSegment.DataElementValue(1) = "ST"
                    oSegment.DataElementValue(2) = oRsPOMaster("ShipToName").Value
                    oSegment.DataElementValue(3) = "9"
                    oSegment.DataElementValue(4) = oRsPOMaster("ShipToID").Value
                    
                    Set oSegment = oTransactionset.CreateDataSegment("N1(2)\N3")
                    oSegment.DataElementValue(1) = oRsPOMaster("ShipToAddress").Value
                    
                    Set oSegment = oTransactionset.CreateDataSegment("N1(2)\N4")
                    oSegment.DataElementValue(1) = oRsPOMaster("ShipToCity").Value
                    oSegment.DataElementValue(2) = oRsPOMaster("ShipToState").Value
                    oSegment.DataElementValue(3) = oRsPOMaster("ShipToZip").Value
                    
                    oRsPODetail.Open "Select * from PODetail where PoMasterKey = " & oRsPOMaster("PoMasterKey").Value, oConn, adOpenDynamic, adLockOptimistic
                    nInstance = 0
                    Do While Not oRsPODetail.EOF
                        nInstance = nInstance + 1
                        Set oSegment = oTransactionset.CreateDataSegment("PO1(" & nInstance & ")\PO1")
                        oSegment.DataElementValue(2) = oRsPODetail.Fields("Quantity")
                        oSegment.DataElementValue(3) = oRsPODetail.Fields("Unit")
                        oSegment.DataElementValue(4) = oRsPODetail.Fields("UnitPrice")
                        oSegment.DataElementValue(5) = " "
                        oSegment.DataElementValue(6) = "CB"
                        oSegment.DataElementValue(7) = oRsPODetail.Fields("CatalogNo")
                        oSegment.DataElementValue(8) = "UA"
                        oSegment.DataElementValue(9) = oRsPODetail.Fields("EAN")
                        
                        Set oSegment = oTransactionset.CreateDataSegment("PO1(" & nInstance & ")\PID\PID")
                        oSegment.DataElementValue(1) = "F"
                        oSegment.DataElementValue(5) = oRsPODetail.Fields("Description")
                        
                        Set oSegment = oTransactionset.CreateDataSegment("PO1(" & nInstance & ")\PO4")
                        oSegment.DataElementValue(1) = oRsPODetail.Fields("Package")
                        oSegment.DataElementValue(2) = oRsPODetail.Fields("Weights")
                        oSegment.DataElementValue(3) = "LB"
                        
                        oRsPODetail.MoveNext
                    Loop
                    oRsPODetail.Close
                    
                    Set oSegment = oTransactionset.CreateDataSegment("CTT\CTT")
                    oSegment.DataElementValue(1) = nInstance
                    
                    oRsPOMaster.MoveNext
                Loop
                oRsPOMaster.Close
                
                oRsTransactionSet.MoveNext
            Loop
            oRsTransactionSet.Close
            
            oRsGroup.MoveNext
        Loop
        oRsGroup.Close
        
        oRsInterchange.MoveNext
    Loop
    oRsInterchange.Close
    
    oEdiDoc.Save sEdiFile
    
    MsgBox (oEdiDoc.GetEdiString())

    oConn.Close
    
    Set oSegment = Nothing
    Set oTransactionset = Nothing
    Set oGroup = Nothing
    Set oInterchange = Nothing
    Set oSchema = Nothing
    Set oEdiDoc = Nothing
    
End Sub
Click here to download a trial version of the Framework EDI
