Private Sub cmdTranslate_Click()
' This routine reads an EDI file and maps the values of its data elements into
' fields of a database.
Dim i As Integer
Dim nCount As Integer
Dim sEntity As String
Dim nIndex As Integer
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
Me.MousePointer = vbHourglass
sSefFile = sPath & "850_4010.SEF"
sEdiFile = sPath & "850.x12"
'instantiate edi doocument object
Set oEdiDoc = New Fredi.ediDocument
'changing the cursor type to forwardonly stops the component from loading the entire EDI file
'into memory. Saves RAM and improves performance.
oEdiDoc.CursorType = Cursor_ForwardOnly
'Makes certain that the internal Standard Reference Library is not used, but use only
'the SEF file provided.
Set oSchemas = oEdiDoc.GetSchemas
oSchemas.EnableStandardReference = False
'Loads the SEF file and EDI file.
oEdiDoc.ImportSchema 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
'map ISA data elements here
oRsInterchange.AddNew
oRsInterchange("InterchangeControlNo").Value = oSegment.DataElementValue(13)
oRsInterchange("SenderID").Value = oSegment.DataElementValue(6)
oRsInterchange("SenderID_Qlfr").Value = oSegment.DataElementValue(7)
sReceiptControlID = oSegment.DataElementValue(13) & oSegment.DataElementValue(6) & oSegment.DataElementValue(7)
oRsInterchange("ReceiptControlID").Value = sReceiptControlID
oRsInterchange.Update
ElseIf sSegmentID = "GS" Then
sGroupNo = oSegment.DataElementValue(6)
ElseIf sSegmentID = "GE" Then
ElseIf sSegmentID = "IEA" Then
oRsInterchange.Update
End If
ElseIf nArea = 1 Then
If sLoopSection = "" Then
If sSegmentID = "ST" Then
'map ST data element here
oRsTransactionSet.AddNew
oRsTransactionSet("ReceiptControlID").Value = sReceiptControlID
oRsTransactionSet("GroupNo").Value = sGroupNo
oRsTransactionSet("TransactionSetControlNo").Value = oSegment.DataElementValue(2)
oRsTransactionSet("TransactionSetNo").Value = oSegment.DataElementValue(1)
oRsTransactionSet.Update
sTSID = oRsTransactionSet("TSID").Value
sTSNo = oRsTransactionSet("TransactionSetNo").Value
sTSControlNo = oRsTransactionSet("TransactionSetControlNo").Value
oRsPOMaster.AddNew
oRsPOMaster("TSID").Value = sTSID
oRsPOMaster("TransactionSetNo").Value = sTSNo
oRsPOMaster("TransactionSetControlNo").Value = sTSControlNo
iIndex = -1
ElseIf sSegmentID = "BEG" Then
sPONumber = oSegment.DataElementValue(3)
sPODate = StringToDate(oSegment.DataElementValue(5))
oRsPOMaster("PONumber").Value = sPONumber
oRsPOMaster("PODate").Value = sPODate
ElseIf sSegmentID = "REF" Then
oRsPOMaster("VendorIDNo").Value = oSegment.DataElementValue(2)
ElseIf sSegmentID = "ITD" Then
oRsPOMaster("DiscountPerc").Value = oSegment.DataElementValue(3)
oRsPOMaster("DiscountDaysDue").Value = oSegment.DataElementValue(5)
oRsPOMaster("NetDays").Value = oSegment.DataElementValue(7)
ElseIf sSegmentID = "DTM" Then
oRsPOMaster("DeliveryDate").Value = StringToDate(oSegment.DataElementValue(2))
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)
ElseIf sSegmentID = "N3" Then
oRsPOMaster("BillToAddress").Value = oSegment.DataElementValue(1)
ElseIf sSegmentID = "N4" Then
oRsPOMaster("BillToCity").Value = oSegment.DataElementValue(1)
oRsPOMaster("BillToState").Value = oSegment.DataElementValue(2)
oRsPOMaster("BillToZip").Value = oSegment.DataElementValue(3)
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)
ElseIf sSegmentID = "N3" Then
oRsPOMaster("ShipToAddress").Value = oSegment.DataElementValue(1)
ElseIf sSegmentID = "N4" Then
oRsPOMaster("ShipToCity").Value = oSegment.DataElementValue(1)
oRsPOMaster("ShipToState").Value = oSegment.DataElementValue(2)
oRsPOMaster("ShipToZip").Value = oSegment.DataElementValue(3)
End If
End If
End If
ElseIf nArea = 2 Then
If sLoopSection = "PO1" Then
If sSegmentID = "PO1" Then
If Not oRsPODetail.EOF Then
oRsPODetail.Update 'save the previous record before creating a new record
End If
oRsPODetail.AddNew
oRsPODetail("TSID").Value = sTSID
oRsPODetail("PONumber").Value = sPONumber
oRsPODetail("PODate").Value = sPODate
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)
ElseIf sSegmentID = "PO4" Then
oRsPODetail("Package").Value = oSegment.DataElementValue(1)
oRsPODetail("Weights").Value = oSegment.DataElementValue(2)
End If
ElseIf sLoopSection = "PO1;PID" Then
If sSegmentID = "PID" Then
oRsPODetail("Description").Value = oSegment.DataElementValue(5)
End If
End If
ElseIf nArea = 3 Then
If sLoopSection = "" Then
If sSegmentID = "CTT" Then
ElseIf sSegmentID = "SE" Then
'The SE segment marks the end of the transaction set so it is a good place to update records
oRsPODetail.Update
oRsPOMaster.Update
End If
End If
End If
'get next data segment
Set oSegment = oSegment.Next
Wend
Set oSegment = Nothing
Me.MousePointer = vbNormal
cmdTranslate.Enabled = False
cmdPrevious.Enabled = True
cmdNext.Enabled = True
cmdPrevious.Enabled = False
oRsPOMaster.Close
oRsPOMaster.Open "Select * from POMaster", oConn, adOpenDynamic, adLockOptimistic
If Not oRsPOMaster.EOF Then
FormRefresh
End If
End Sub
