Private Sub Command0_Click() Dim oEdiDoc As Fredi.ediDocument Dim oSegment As Fredi.ediDataSegment Dim oSchemas As Fredi.ediSchemas 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 sInterchangeControlNo As String Dim sGroupControlNo As String Dim sTSNo As String Dim sTSControlNo As String Dim sPath As String Dim nInterchangeKey As Long Dim nGroupKey As Long Dim nTsKey As Long Dim nPoMasterKey As Long Dim nPoDetailKey As Long Dim i As Integer Dim sEntity As String Dim sSefFile As String Dim sEdiFile As String Dim sSegmentID As String Dim sLoopSection As String Dim nArea As Integer Dim sPONumber As String Dim sPODate As String Dim iIndex As Integer sPath = CurrentProject.Path & "\" sConn = "Provider=Microsoft.Jet.OLEDB.4.0; Data Source=" & sPath & "tran850.mdb" Set oConn = New ADODB.Connection oConn.Open sConn 'The InterchangeIndex table stores information for each Interchange received. Set oRsInterchange = New ADODB.Recordset oRsInterchange.Open "InterchangeIndex", oConn, adOpenDynamic, adLockOptimistic 'The GroupIndex table stores information for each Group received. Set oRsGroup = New ADODB.Recordset oRsGroup.Open "GroupIndex", oConn, adOpenDynamic, adLockOptimistic 'The TransactionSetIndex table stores information of the Transaction Sets Set oRsTransactionSet = New ADODB.Recordset oRsTransactionSet.Open "TransactionSetIndex", oConn, adOpenDynamic, adLockOptimistic 'The POMaster table stores information of the Purchase Order in the Transaction Set Set oRsPOMaster = New ADODB.Recordset oRsPOMaster.Open "POMaster", oConn, adOpenDynamic, adLockOptimistic 'The PODetail table stores information of the detailed items of Purchase Orders Set oRsPODetail = New ADODB.Recordset oRsPODetail.Open "PODetail", oConn, adOpenDynamic, adLockOptimistic sSefFile = sPath & "850_4010.EVAL0.SEF" 'EVALUATION SEF FILE sEdiFile = sPath & "850.x12" Set oEdiDoc = New Fredi.ediDocument 'Makes certain that the internal Standard Reference Library is not used, but only 'the SEF file provided. Set oSchemas = oEdiDoc.GetSchemas oSchemas.EnableStandardReference = False 'Loads the SEF file and EDI file. oEdiDoc.LoadSchema sSefFile, 0 oEdiDoc.LoadEdi sEdiFile 'Gets the first data segment of the EDI file Set oSegment = oEdiDoc.FirstDataSegment 'Traverse thru the EDI file. A data segment is identified by its segment ID, its loop 'section, and Area (or table) number. 'The values of the data elements of the segments are then stored into a database While Not oSegment Is Nothing sSegmentID = oSegment.ID sLoopSection = oSegment.LoopSection nArea = oSegment.Area If nArea = 0 Then If sSegmentID = "ISA" Then oRsInterchange.AddNew sInterchangeControlNo = oSegment.DataElementValue(13) oRsInterchange("InterchangeControlNo").Value = sInterchangeControlNo oRsInterchange("SenderID_Qlfr").Value = oSegment.DataElementValue(5) oRsInterchange("SenderID").Value = oSegment.DataElementValue(6) oRsInterchange("ReceiverID_Qlfr").Value = oSegment.DataElementValue(7) oRsInterchange("ReceiverID").Value = oSegment.DataElementValue(8) oRsInterchange("Version").Value = oSegment.DataElementValue(12) oRsInterchange.Update nInterchangeKey = oRsInterchange("InterchangeKey").Value ElseIf sSegmentID = "GS" Then oRsGroup.AddNew sGroupControlNo = oSegment.DataElementValue(6) oRsGroup("GroupNo").Value = sGroupControlNo oRsGroup("InterchangeKey").Value = nInterchangeKey oRsGroup("InterchangeControlNo").Value = sInterchangeControlNo oRsGroup("Version").Value = oSegment.DataElementValue(8) oRsGroup("FunctionalIdCode").Value = oSegment.DataElementValue(1) oRsGroup("SenderDept").Value = oSegment.DataElementValue(2) oRsGroup("ReceiverDept").Value = oSegment.DataElementValue(3) oRsGroup.Update nGroupKey = oRsGroup("GroupKey").Value End If ElseIf nArea = 1 Then If sLoopSection = "" Then If sSegmentID = "ST" Then oRsTransactionSet.AddNew sTSControlNo = oSegment.DataElementValue(2) oRsTransactionSet("TransactionSetControlNo").Value = sTSControlNo oRsTransactionSet("GroupKey") = nGroupKey oRsTransactionSet("GroupNo").Value = sGroupNo sTSNo = oSegment.DataElementValue(1) oRsTransactionSet("TransactionSetNo").Value = sTSNo oRsTransactionSet.Update nTsKey = oRsTransactionSet("TsKey").Value oRsPOMaster.AddNew oRsPOMaster("TsKey").Value = nTsKey oRsPOMaster("TransactionSetNo").Value = sTSNo oRsPOMaster("TransactionSetControlNo").Value = sTSControlNo iIndex = -1 oRsPOMaster.Update nPoMasterKey = oRsPOMaster("PoMasterKey").Value ElseIf sSegmentID = "BEG" Then sPONumber = oSegment.DataElementValue(3) sPODate = StringToDate(oSegment.DataElementValue(5)) oRsPOMaster("PONumber").Value = sPONumber oRsPOMaster("PODate").Value = sPODate oRsPOMaster.Update ElseIf sSegmentID = "REF" Then oRsPOMaster("VendorIDNo").Value = oSegment.DataElementValue(2) oRsPOMaster.Update ElseIf sSegmentID = "ITD" Then oRsPOMaster("DiscountPerc").Value = oSegment.DataElementValue(3) oRsPOMaster("DiscountDaysDue").Value = oSegment.DataElementValue(5) oRsPOMaster("NetDays").Value = oSegment.DataElementValue(7) oRsPOMaster.Update ElseIf sSegmentID = "DTM" Then oRsPOMaster("DeliveryDate").Value = StringToDate(oSegment.DataElementValue(2)) oRsPOMaster.Update End If ElseIf sLoopSection = "N1" Then 'Obtains the qulaifier for the loop to determine the kind of information the 'segments in the loop holds If sSegmentID = "N1" Then sEntity = oSegment.DataElementValue(1) End If If sEntity = "BT" Then 'Bill To Information If sSegmentID = "N1" Then oRsPOMaster("BillToName").Value = oSegment.DataElementValue(2) oRsPOMaster("BillToID").Value = oSegment.DataElementValue(4) oRsPOMaster.Update ElseIf sSegmentID = "N3" Then oRsPOMaster("BillToAddress").Value = oSegment.DataElementValue(1) oRsPOMaster.Update ElseIf sSegmentID = "N4" Then oRsPOMaster("BillToCity").Value = oSegment.DataElementValue(1) oRsPOMaster("BillToState").Value = oSegment.DataElementValue(2) oRsPOMaster("BillToZip").Value = oSegment.DataElementValue(3) oRsPOMaster.Update End If ElseIf sEntity = "ST" Then 'Ship To Information If sSegmentID = "N1" Then oRsPOMaster("ShipToName").Value = oSegment.DataElementValue(2) oRsPOMaster("ShipToID").Value = oSegment.DataElementValue(4) oRsPOMaster.Update ElseIf sSegmentID = "N3" Then oRsPOMaster("ShipToAddress").Value = oSegment.DataElementValue(1) oRsPOMaster.Update ElseIf sSegmentID = "N4" Then oRsPOMaster("ShipToCity").Value = oSegment.DataElementValue(1) oRsPOMaster("ShipToState").Value = oSegment.DataElementValue(2) oRsPOMaster("ShipToZip").Value = oSegment.DataElementValue(3) oRsPOMaster.Update End If End If End If ElseIf nArea = 2 Then If sLoopSection = "PO1" Then If sSegmentID = "PO1" Then oRsPODetail.AddNew oRsPODetail("PoMasterKey").Value = nPoMasterKey oRsPODetail("PONumber").Value = sPONumber oRsPODetail("PODate").Value = sPODate oRsPODetail.Update iIndex = iIndex + 1 oRsPODetail("LineNo").Value = iIndex oRsPODetail("Quantity").Value = oSegment.DataElementValue(2) oRsPODetail("Unit").Value = oSegment.DataElementValue(3) oRsPODetail("UnitPrice").Value = oSegment.DataElementValue(4) oRsPODetail("CatalogNo").Value = oSegment.DataElementValue(7) oRsPODetail("EAN").Value = oSegment.DataElementValue(9) oRsPODetail.Update ElseIf sSegmentID = "PO4" Then oRsPODetail("Package").Value = oSegment.DataElementValue(1) oRsPODetail("Weights").Value = oSegment.DataElementValue(2) oRsPODetail.Update End If ElseIf sLoopSection = "PO1;PID" Then If sSegmentID = "PID" Then oRsPODetail("Description").Value = oSegment.DataElementValue(5) oRsPODetail.Update End If End If ElseIf nArea = 3 Then If sLoopSection = "" Then If sSegmentID = "CTT" Then ElseIf sSegmentID = "SE" Then End If End If End If Set oSegment = oSegment.Next Wend oRsPODetail.Close oRsPOMaster.Close oRsTransactionSet.Close oRsGroup.Close oRsInterchange.Close oConn.Close Set oSchemas = Nothing Set oEdiDoc = Nothing MsgBox "Done" End Sub