Export Customer Order Agreements to Solomon Processing

The processing exports confirmed Customer Order Agreements (COAs) to a text file when the Export to Solomon button is clicked. The data is then imported into the Solomon System.

Option Compare Database 'Use database order for string comparisons

'These should be set as appropriate for the system

'can be changed to variables if desired

'Const OutputPath = "S:\Clients\Demptos\"

'Const OutputPath = "C:"

'Const InputPath = "Q:\"

Const OutputPath = "\\xxx\Acctg\Sol4\DOIxfer\"

Const InputPath = "\\xxx\Acctg\Sol4\DOIxfer\"

Option Explicit

Private Sub cmdProcess_Click_Click()

On Error GoTo Err_cmdProcess_Click

Export

Exit_cmdProcess_Click:

Exit Sub

Err_cmdProcess_Click:

beep

MSG = "Error # " & str(Err) & " was generated by: " & Chr(13)

MSG = MSG & "Form: " & Me.Name & Chr(13) & "Module: " & "btn_Process_Click"

MSG = MSG & Chr(13) & "ERROR MESSAGE: " & Error(Err)

Msgbox MSG, vbCritical, "ERROR MESSAGE"

Resume Exit_cmdProcess_Click

End Sub

Private Sub Form_Close()

On Error GoTo Err_Form_Close

Dim str_result As String

If Me.Tag = "" Or IsNull(Me.Tag) Then Exit Sub

str_result = Me.Tag

If str_result = "frm_Utilities" Then

DoCmd.OpenForm str_result, acNormal, , , , acNormal, "frm_Main"

Exit Sub

End If

Exit_Form_Close:

Exit Sub

Err_Form_Close:

beep

MSG = "Error # " & str(Err) & " was generated by: " & Chr(13)

MSG = MSG & "Form: " & Me.Name & Chr(13) & "Module: " & "Form_Close"

MSG = MSG & Chr(13) & "ERROR MESSAGE: " & Error(Err)

Msgbox MSG, vbCritical, "ERROR MESSAGE"

Resume Exit_Form_Close

End Sub

Private Sub Form_Open(Cancel As Integer)

On Error GoTo Err_Form_Open

Dim focus_ctr As String

Dim x As Integer

If Me.OpenArgs <> "" Or Not IsNull(Me.OpenArgs) Then

Me.Tag = Trim$(Me.OpenArgs)

End If

focus_ctr = "Message"

Exit_Form_Open:

Exit Sub

Err_Form_Open:

beep

MSG = "Error # " & str(Err) & " was generated by: " & Chr(13)

MSG = MSG & "Form: " & Me.Name & Chr(13) & "Module: " & "Form_Open"

MSG = MSG & Chr(13) & "ERROR MESSAGE: " & Error(Err)

Msgbox MSG, vbCritical, "ERROR MESSAGE"

Resume Exit_Form_Open

End Sub

Private Sub UpdateScreen(MSG As String)

On Error GoTo Err_UpdateScreen

Me![Message].Caption = MSG

DoCmd.RepaintObject acForm, "frmExport"

Exit_UpdateScreen:

Exit Sub

Err_UpdateScreen:

beep

MSG = "Error # " & str(Err) & " was generated by: " & Chr(13)

MSG = MSG & "Form: " & Me.Name & Chr(13) & "Module: " & "UpdateScreen"

MSG = MSG & Chr(13) & "ERROR MESSAGE: " & Error(Err)

Msgbox MSG, vbCritical, "ERROR MESSAGE"

Resume Exit_UpdateScreen

End Sub

Public Sub Export()

On Error GoTo Err_Export

Dim RS As Recordset

Dim sqlStr As String

Dim Country As String

Dim Addr1 As String

Dim Addr2 As String

Dim Name As String

Dim i_FileOpen1 As Integer

Dim i_FileOpen2 As Integer

Dim i_processcounter As Integer

Dim i_recordcounter As Integer

Dim i_result As Integer

Dim i_RSCounter As Integer

Dim i_rsOpen As Integer

Dim i_TransStarted As Integer

Dim i As Integer

Dim i_LookUpOpen

'This process is intended to be run in single user mode -

'i.e. no other users are entering or changing data on other workstations

'during this process.

beep

If Msgbox("Export to Solomon should be run in single user mode." & Chr(10) & Chr(13) _

& "Other users should not be entering or changing data on other computers.", _

vbOKCancel, "Export to Solomon") = vbCancel Then Exit Sub

i_TransStarted = False

i_FileOpen1 = False

i_FileOpen2 = False

i_rsOpen = False

i_LookUpOpen = False

DoCmd.Hourglass True

i_recordcounter = 0

i_processcounter = 0

'Export Customers

If Me.ChkCustomers.Value = True Then

sqlStr = "SELECT * FROM Customers"

sqlStr = sqlStr & " WHERE UpdateSolomon or InsertSolomon ORDER BY SolomonCustomerID"

Set RS = db.OpenRecordset(sqlStr, dbOpenDynaset)

i_rsOpen = True

i_RSCounter = RS.RecordCount

i_result = SysCmd(acSysCmdInitMeter, "Processing Customer records# ", i_RSCounter)

MSG = "Processing Customer Data, # Of Records = " & RS.RecordCount

Call UpdateScreen(MSG)

Open OutputPath & "0826000.DOI" For Append As #1

Open OutputPath & "0826200.DOI" For Append As #2

i_FileOpen1 = True

i_FileOpen2 = True

Do While Not RS.EOF

If RS!Country & "" = "" Then

Country = "USA"

Else

Country = Left(RS!Country, 3)

End If

Name = Left(RS!CustomerName & "", 30)

If RS!Address1 & "" <> "" Then

Addr1 = Left(RS!Address1, 30)

Else

Addr1 = " "

End If

If RS!Address2 & "" <> "" Then

Addr2 = Left(RS!Address2, 30)

Else

Addr2 = " "

End If

' cCustID cName,cClassId,cStatus,cAttn,cSalut,cAddr1,cAddr2,cCity, cState, cZip, cCountry, cPhone, cFax,cCrLmt,cTradeDisc,cPrcLvlId,cTerms,cBillName,cBillAttn,cBillSalut,cBillAddr1,cBillAddr2,cBillCity,cBillState,cBillZip,cBillCountry,cBillPhone,cBillFax,cTaxDflt,cTaxRegNbr

Print #1, "Customer"; Delim(RS!SolomonCustomerID); Delim(Name); ",,A,,"; Delim(Addr1); Delim(Addr2); Delim(RS!City); Delim(RS!State); Delim(RS!PostalCode); Delim(Country); Delim(Strip(RS!PhoneNumber)); Delim(Strip(RS!FaxNumber)); ",,,,,,,,,,,,,,,,"; Delim(RS!ResaleNumber)

Print #2, Mid$(Delim("Customer,Change"), 2); Delim(RS!SolomonCustomerID)

If RS!ShipCountry & "" = "" Then

Country = "USA"

Else

Country = Left(RS!ShipCountry, 3)

End If

If RS!ShipAddress1 & "" <> "" Then

Addr1 = Left(RS!ShipAddress1, 30)

Else

Addr1 = " "

End If

If RS!ShipAddress2 & "" <> "" Then

Addr2 = Left(RS!ShipAddress2, 30)

Else

Addr2 = " "

End If

Print #2, "ShippingAddress,DEFAULT"; Delim(Name); Delim(Left(RS!ShipName & "", 30)); Delim(RS!ShipContactName); Delim(Addr1); Delim(Addr2); Delim(RS!ShipCity); Delim(RS!ShipState); Delim(RS!ShipPostalCode); Delim(Country); Delim(Strip(RS!ShipPhoneNumber)); Delim(Strip(RS!ShipFaxNumber))

i_recordcounter = i_recordcounter + 1

i_processcounter = i_processcounter + 1

MSG = "Writing Customer Record # = " & i_recordcounter

Call UpdateScreen(MSG)

i_result = SysCmd(acSysCmdUpdateMeter, i_processcounter)

RS.MoveNext

Loop

Close #2

Close #1

i_FileOpen1 = False

i_FileOpen2 = False

RS.Close

i_rsOpen = False

End If

If Me.ChkProductCodes.Value = True Then

'Export Products...

Dim Lookup As Recordset, ProdDesc As String

sqlStr = "SELECT Products.ProductCode, Products.Cooperage, Products.SizeCode, Products.Style, Products.ForestOrigin, Products.ToastLevel, Products.ToastedHeads, Cooperage.CooperageDesc, SizeTable.SizeDesc, Style.StyleDesc, ForestOrigin.ForestDesc, ToastLevel.ToastLevelDesc"

sqlStr = sqlStr & " FROM ((((Products LEFT JOIN Cooperage ON Products.Cooperage = Cooperage.Cooperage) LEFT JOIN SizeTable ON Products.SizeCode = SizeTable.SizeCode) LEFT JOIN Style ON Products.Style = Style.Style) LEFT JOIN ForestOrigin ON Products.ForestOrigin = ForestOrigin.ForestOrigin) LEFT JOIN ToastLevel ON Products.ToastLevel = ToastLevel.ToastLevel"

sqlStr = sqlStr & " WHERE InsertSolomon ORDER BY ProductCode"

Set RS = db.OpenRecordset(sqlStr, dbOpenDynaset)

i_rsOpen = True

Set Lookup = db.OpenRecordset("SELECT * FROM SolomonLookup ORDER BY SortOrder", dbOpenDynaset)

i_LookUpOpen = True

SysCmd (acSysCmdRemoveMeter)

i_RSCounter = RS.RecordCount

i_result = SysCmd(acSysCmdInitMeter, "Processing Product records ", i_RSCounter)

MSG = "Processing Product Data, # Of Records = " & RS.RecordCount

Call UpdateScreen(MSG)

Open OutputPath & "1025000.DOI" For Append As #1

i_FileOpen1 = True

i_recordcounter = 0

i_processcounter = 0

Do While Not RS.EOF

ProdDesc = RS!CooperageDesc & DescSeg(RS!SizeDesc) & DescSeg(RS!StyleDesc) & DescSeg(RS!ForestDesc) & DescSeg(RS!ToastLevelDesc)

If RS!ToastedHeads Then

ProdDesc = ProdDesc & " TH"

End If

FindMatch RS, Lookup

Print #1, "InventoryItem"; Delim(RS!ProductCode); Delim(Lookup!ProductClass); Delim(ProdDesc); ",1"; Delim(Lookup!InvType); Delim(Lookup!Source); ",F,,EACH,A"; Delim(Lookup![Inv Acct]); Delim(Lookup![Inv Sub]); Delim(Lookup![COGS Acct]); Delim(Lookup![COGS Sub]); Delim(Lookup![Sales Acct]); Delim(Lookup![Sales Sub]) & ",,,,,,,P,Q"

i_recordcounter = i_recordcounter + 1

i_processcounter = i_processcounter + 1

i_result = SysCmd(acSysCmdUpdateMeter, i_processcounter)

MSG = "Writing Product Record # = " & i_recordcounter

Call UpdateScreen(MSG)

RS.MoveNext

Loop

Close #1

i_FileOpen1 = False

RS.Close

i_rsOpen = False

Lookup.Close

i_LookUpOpen = False

End If

If Me.ChkCOAs.Value = True Then

'Export COAs...

Dim CurOrder As String

'SELECT COAInformation.*, COADetail.*, Customers.SolomonCustomerID

'FROM (COAInformation LEFT JOIN COADetail ON COAInformation.COANumber = COADetail.COANumber) INNER JOIN Customers ON COAInformation.CustomerCode = Customers.CustomerCode;

sqlStr = "SELECT COAInformation.*, COADetail.*, Customers.SolomonCustomerID"

sqlStr = sqlStr & " FROM (COAInformation LEFT JOIN COADetail ON COAInformation.COANumber = COADetail.COANumber)"

sqlStr = sqlStr & " INNER JOIN Customers ON COAInformation.CustomerCode = Customers.CustomerCode" 'FROM COAInformation LEFT JOIN COADetail ON COAInformation.COANumber = COADetail.COANumber"

sqlStr = sqlStr & " WHERE COAConfirmed AND COAInformation.InsertSolomon ORDER BY COAInformation.COANumber"

Set RS = db.OpenRecordset(sqlStr, dbOpenDynaset)

i_rsOpen = True

i_RSCounter = RS.RecordCount

i_result = SysCmd(acSysCmdInitMeter, "Processing COA records# ", i_RSCounter)

MSG = "Processing COA Data, # Of Records = " & RS.RecordCount

Call UpdateScreen(MSG)

Open OutputPath & "0526000.DOI" For Append As #1

Do While Not RS.EOF

CurOrder = Right$(RS![COAInformation.COANumber], 6)

If RS!Country & "" = "" Then

Country = "USA"

Else

Country = Left(RS!Country, 3)

End If

Name = Left(RS!CustomerName & "", 30)

If RS!Address1 & "" <> "" Then

Addr1 = Left(RS!Address1, 30)

Else

Addr1 = " "

End If

If RS!Address2 & "" <> "" Then

Addr2 = Left(RS!Address2, 30)

Else

Addr2 = " "

End If

' cOrdTypeH,cOrdNbrH,iBOCntr,cBlktOrdNbr,cCustId,cStatus,cBillName,cShipToId,cShipName, cOrdDate, cCustOrdNbr, cOurPONbr,cSalesperId,cCmmnPctH,cBillName01,cBillAttn01,cBillAddr1,cBillAddr2,cBillCity,cBillState,cBillZip,cBillCountry,cDocDesc,cTerms

Print #1, "Order,OR"; Delim(CurOrder); ",,"; Delim(RS!SolomonCustomerID); ",O,,"; Delim(Left(RS!ShipName & "", 30)); Delim(RS!OrderDate); Delim(Left$(RS!CustomerPO & "", 15)); Delim(Left$(RS!DNCPO & "", 6)); ",,,,"; ",,,,,,"; ","; Delim(RS!TermDays); ",,,";

If RS!ShipCountry & "" = "" Then

Country = "USA"

Else

Country = Left(RS!ShipCountry, 3)

End If

If RS!ShipAddress1 & "" <> "" Then

Addr1 = Left(RS!ShipAddress1, 30)

Else

Addr1 = " "

End If

If RS!ShipAddress2 & "" <> "" Then

Addr2 = Left(RS!ShipAddress2, 30)

Else

Addr2 = " "

End If

Print #1, Delim(Left$(RS!ShipName & "", 30)); Delim(RS!ShipContactName); Delim(Left$(Addr1 & "", 30)); Delim(Left$(Addr2 & "", 30)); Delim(RS!ShipCity); Delim(RS!ShipState); Delim(RS!ShipPostalCode); Delim(Country); Delim(RS!ProjectedDelivery); ","; Delim(Left$(RS!FOB, 15)); ",0,,"; RS!ShipHandling

Do While CurOrder = Right$(RS![COAInformation.COANumber], 6)

Print #1, "Detail"; Delim(RS![ProductCode]); ",,,,,,EACH,,"; RS!Quantity; ","; RS!QuantityToShip; ","; RS!Price

RS.MoveNext

If RS.EOF Then Exit Do

Loop

i_recordcounter = i_recordcounter + 1

i_processcounter = i_processcounter + 1

i_result = SysCmd(acSysCmdUpdateMeter, i_processcounter)

MSG = "Writing COA Record # = " & i_recordcounter

Call UpdateScreen(MSG)

Loop

Close #1

RS.Close

i_rsOpen = False

'after exporting, reset the flags so they won't be sent again

End If

If (Me.ChkCustomers.Value = True Or Me.ChkProductCodes = True Or Me.ChkCOAs = True) Then

WK.BeginTrans

i_TransStarted = True

End If

'after exporting, reset the flags so they won't be sent again

If Me.ChkCustomers.Value = True Then

db.Execute ("INSERT INTO tblExportLog ( RecordID, RecordType )SELECT Customers.CustomerCode, 'Customer' AS RecordType FROM Customers WHERE (((Customers.InsertSolomon)=True)) OR (((Customers.UpdateSolomon)=True))")

db.Execute ("UPDATE Customers SET UpdateSolomon = False, InsertSolomon = False WHERE UpdateSolomon or InsertSolomon")

End If

If Me.ChkProductCodes.Value = True Then

db.Execute ("INSERT INTO tblExportLog ( RecordID, RecordType )SELECT Products.ProductCode, 'Product' AS RecordType FROM Products WHERE Products.InsertSolomon=True")

db.Execute ("UPDATE Products SET InsertSolomon = False WHERE InsertSolomon")

End If

If Me.ChkCOAs.Value = True Then

db.Execute ("INSERT INTO tblExportLog ( RecordID, RecordType, CustomerName ) SELECT COAInformation.COANumber, 'COA' AS RecordType, CustomerName FROM COAInformation WHERE COAInformation.InsertSolomon = True AND COAInformation.COAConfirmed = True")

db.Execute ("UPDATE COAInformation SET InsertSolomon = False WHERE InsertSolomon AND COAConfirmed")

End If

If (Me.ChkCustomers.Value = True Or Me.ChkProductCodes = True Or Me.ChkCOAs = True) Then

WK.CommitTrans

i_TransStarted = False

End If

Dim Errors As Boolean

Errors = False

Exit_Export:

If i_FileOpen2 Then

Close #2

End If

If i_FileOpen1 Then

Close #1

End If

If i_rsOpen Then

i_rsOpen = False

RS.Close

End If

If i_LookUpOpen Then

Lookup.Close

i_LookUpOpen = False

End If

DoCmd.Hourglass False

SysCmd (acSysCmdRemoveMeter)

beep

If Errors = False Then

Msgbox "Export to Solomon Complete", vbInformation, "Export Complete"

btn_Exit.SetFocus

Else

Msgbox "Export with Errors", vbCritical, "Export Errors"

End If

Exit Sub

Err_Export:

DoCmd.Hourglass False

beep

Errors = True

MSG = "Error # " & str(Err) & " was generated by: " & Chr(13)

MSG = MSG & "Form: " & Me.Name & Chr(13) & "Module: " & "Export"

MSG = MSG & Chr(13) & "ERROR MESSAGE: " & Error(Err)

Msgbox MSG, vbCritical, "ERROR MESSAGE"

If i_TransStarted Then

WK.Rollback

i_TransStarted = False

End If

Resume Exit_Export

End Sub

Public Sub FindMatch(RS As Recordset, Lookup As Recordset)

On Error GoTo Err_FindMatch

Dim MatchFound As Boolean

Lookup.MoveFirst

Do While Not Lookup.EOF

If Lookup!Cooperage = "*" Or Lookup!Cooperage = RS!Cooperage Then

If Lookup!SizeCode = "*" Or Lookup!SizeCode = RS!SizeCode Then

If Lookup!Style = "*" Or Lookup!Style = RS!Style Then

If Lookup!ForestOrigin = "*" Or Lookup!ForestOrigin = RS!ForestOrigin Then

If Lookup!ToastLevel = "*" Or Lookup!ToastLevel = RS!ToastLevel Then

MatchFound = True

Exit Do

End If

End If

End If

End If

End If

Lookup.MoveNext

Loop

Exit_FindMatch:

Exit Sub

Err_FindMatch:

beep

MSG = "Error # " & str(Err) & " was generated by: " & Chr(13)

MSG = MSG & "Form: " & Me.Name & Chr(13) & "Module: " & "FindMatch"

MSG = MSG & Chr(13) & "ERROR MESSAGE: " & Error(Err)

Msgbox MSG, vbCritical, "ERROR MESSAGE"

Resume Exit_FindMatch

End Sub

Public Function DescSeg(s) As String

On Error GoTo Err_DescSeg

If s & "" <> "" Then

DescSeg = ", " & s

Else

DescSeg = ""

End If

Exit_DescSeg:

Exit Function

Err_DescSeg:

beep

MSG = "Error # " & str(Err) & " was generated by: " & Chr(13)

MSG = MSG & "Form: " & Me.Name & Chr(13) & "Module: " & "DescSeg"

MSG = MSG & Chr(13) & "ERROR MESSAGE: " & Error(Err)

Msgbox MSG, vbCritical, "ERROR MESSAGE"

Resume Exit_DescSeg

End Function

Public Function Delim(s) As String

On Error GoTo Err_Delim

Delim = "," & Chr$(34) & s & Chr$(34)

Exit_Delim:

Exit Function

Err_Delim:

beep

MSG = "Error # " & str(Err) & " was generated by: " & Chr(13)

MSG = MSG & "Form: " & Me.Name & Chr(13) & "Module: " & "Delim"

MSG = MSG & Chr(13) & "ERROR MESSAGE: " & Error(Err)

Msgbox MSG, vbCritical, "ERROR MESSAGE"

Resume Exit_Delim

End Function

Public Function Strip(s) As String

On Error GoTo Err_Strip

Dim outStr As String, i As Long

s = "" & s

For i = 1 To Len(s)

'If InStr("()/-x#.,& ABCDEFGHIJKLMNOPQRSTUVWXYZ", UCase$(Mid$(s, i, 1))) = 0 Then

If InStr("0123456789", Mid$(s, i, 1)) <> 0 Then

outStr = outStr & Mid$(s, i, 1)

End If

Next

Strip = outStr

Exit_Strip:

Exit Function

Err_Strip:

beep

MSG = "Error # " & str(Err) & " was generated by: " & Chr(13)

MSG = MSG & "Form: " & Me.Name & Chr(13) & "Module: " & "Strip"

MSG = MSG & Chr(13) & "ERROR MESSAGE: " & Error(Err)

Msgbox MSG, vbCritical, "ERROR MESSAGE"

Resume Exit_Strip

End Function