home *** CD-ROM | disk | FTP | other *** search
/ Planet Source Code Jumbo …e CD Visual Basic 1 to 7 / 5_2007-2008.ISO / data / Zips / Accounting2021969272006.psc / Bank_Module.bas < prev   
BASIC Source File  |  2000-01-20  |  33KB  |  986 lines
  1. Attribute VB_Name = "Bank_Module"
  2.  
  3. Function PostDeposit(DocumentKey&) As Integer
  4.  
  5.   'On Error GoTo PostDeposit_Error
  6.  
  7.   Dim msg$
  8.   Dim title$
  9.  
  10.   Dim db As ADODB.Connection
  11.   Set db = New ADODB.Connection
  12.   db.CursorLocation = adUseServer
  13.   db.Open gblADOProvider
  14.   
  15.   Dim rsCompany As ADODB.Recordset
  16.   Set rsCompany = New ADODB.Recordset
  17.   rsCompany.Open "[SYS Company]", db, adOpenStatic, adLockOptimistic, adCmdTable
  18.   rsCompany.MoveFirst
  19.  
  20.   Dim rsGLWorkDetail As ADODB.Recordset
  21.   Set rsGLWorkDetail = New ADODB.Recordset
  22.   rsGLWorkDetail.Open "[GL Work Detail]", db, adOpenStatic, adLockOptimistic, adCmdTable
  23.   
  24.   Dim rsBankTrans As ADODB.Recordset
  25.   Set rsBankTrans = New ADODB.Recordset
  26.   rsBankTrans.Open "[BANK Transaction]", db, adOpenStatic, adLockOptimistic, adCmdTable
  27.  
  28.   ' first lets get the Credit Memo
  29.   'rsBankTrans.Index = "PrimaryKey"
  30.   'rsBankTrans.Seek DocumentKey&
  31.   rsBankTrans.Find "[BANK TRANS ID]=" & DocumentKey&
  32.  
  33.   If rsBankTrans("BANK TRANS Beg Balance") = True Then
  34.     PostDeposit% = True
  35.     Exit Function
  36.   End If
  37.  
  38.   'Post by 1 - system date or 2 - Transaction date?
  39.   Dim PostDate%
  40.   PostDate% = rsCompany("SYS COM GL Post By Date")
  41.  
  42.   'Set Post Date
  43.   Dim TranDate As Variant
  44.   If PostDate% = 1 Then
  45.     TranDate = DateValue(Format(Now, "Short Date"))
  46.   Else
  47.     TranDate = DateValue(rsBankTrans("BANK TRANS Date"))
  48.   End If
  49.  
  50.   'Verify period can be posted to
  51.   'Send TranDate
  52.   'Return PeriodToPost and PeriodClosed
  53.   Dim PeriodToPost%
  54.   Dim PeriodClosed%
  55.   Call VerifyPeriod(TranDate, PeriodToPost%, PeriodClosed%, db)
  56.   
  57.   'Is period open?
  58.   If PeriodClosed% = True Then
  59.     MsgBox "Unable to post transaction to a closed period.", , "Post Invoice Error"
  60.     GoTo UnableToPostDepositHere
  61.   End If
  62.  
  63.   'On Error GoTo PostDeposit_Error
  64.  
  65.   ' clear any GL Work records
  66.   Dim cmdtemp As ADODB.Recordset
  67.   Set cmdtemp = New ADODB.Recordset
  68.   cmdtemp.Open "DELETE DISTINCTROW * FROM [GL Work Detail]", db, , , adCmdText
  69.   'cmdtemp.Close
  70.   Set cmdtemp = Nothing
  71.     
  72.   Dim rsGLTrans As ADODB.Recordset
  73.   Set rsGLTrans = New ADODB.Recordset
  74.   rsGLTrans.Open "[GL Transaction]", db, adOpenStatic, adLockOptimistic, adCmdTable
  75.  
  76.   ' write GL Transaction Header
  77.   Dim refr$
  78.   Dim desc$
  79.   Dim NewNumber&
  80.   rsGLTrans.AddNew
  81.     
  82.     rsGLTrans("GL TRANS Document #") = "MDEP " & rsBankTrans("BANK TRANS Ext Document No")
  83.     
  84.     ' gl post date
  85.     If PostDate% = 1 Then
  86.       rsGLTrans("GL TRANS Date") = Format(Now, "Short Date")
  87.     Else
  88.       rsGLTrans("GL TRANS Date") = rsBankTrans("BANK TRANS Date")
  89.     End If
  90.     
  91.     rsGLTrans("GL TRANS Type") = "Misc Deposit"
  92.  
  93.     refr$ = IIf(IsNull(rsBankTrans("BANK TRANS Reference")), "", rsBankTrans("BANK TRANS Reference"))
  94.     
  95.     rsGLTrans("GL TRANS Reference") = refr$
  96.     rsGLTrans("GL TRANS Amount") = rsBankTrans("BANK TRANS Amount")
  97.     rsGLTrans("GL TRANS Posted YN") = 1
  98.     desc$ = refr$
  99.     If Len(Trim$(desc$)) = 0 Then
  100.       desc$ = "MDEP " & rsBankTrans("BANK TRANS Ext Document No")
  101.     End If
  102.     rsGLTrans("GL TRANS Description") = desc$
  103.     rsGLTrans("GL TRANS Source") = "MDEP " & rsBankTrans("BANK TRANS Ext Document No")
  104.     rsGLTrans("GL TRANS System Generated") = True
  105.   rsGLTrans.Update
  106.     NewNumber& = rsGLTrans("GL TRANS Number")
  107.  
  108.   
  109.   '                 Debit   Credit    Source
  110.   '                 -----   ------    ------
  111.   ' Bank Account      X               cboBankDep.text
  112.   ' Combo Selection           X       txtDepositAcct$
  113.   
  114.   Dim rsGLTransDetail As ADODB.Recordset
  115.   Set rsGLTransDetail = New ADODB.Recordset
  116.   rsGLTransDetail.Open "[GL Transaction Detail]", db, adOpenStatic, adLockOptimistic, adCmdTable
  117.   
  118.   ' debit
  119.   rsGLTransDetail.AddNew
  120.     rsGLTransDetail("GL TRANSD Number") = NewNumber&
  121.     rsGLTransDetail("GL TRANSD Account") = rsBankTrans("BANK TRANS Bank Acct 1")
  122.     rsGLTransDetail("GL TRANSD Debit Amount") = rsBankTrans("BANK TRANS Amount")
  123.     rsGLTransDetail("GL TRANSD Credit Amount") = 0
  124.   rsGLTransDetail.Update
  125.  
  126.   Dim AccountPost$
  127.   Dim CreditAmount@
  128.   Dim DebitAmount@
  129.   Dim Success%
  130.  
  131.   AccountPost$ = rsBankTrans("BANK TRANS Bank Acct 1")
  132.   DebitAmount@ = rsBankTrans("BANK TRANS Amount")
  133.   CreditAmount@ = 0
  134.   Success% = PostCOA(AccountPost$, TranDate, DebitAmount@, CreditAmount@)
  135.   If Success% = False Then
  136.     MsgBox "An error occurred posting the transaction to the GL!", , "Error"
  137.     PostDeposit% = False
  138.     Exit Function
  139.   End If
  140.  
  141.  
  142.   ' credit
  143.   rsGLTransDetail.AddNew
  144.     rsGLTransDetail("GL TRANSD Number") = NewNumber&
  145.     rsGLTransDetail("GL TRANSD Account") = rsBankTrans("BANK TRANS Bank Acct 2")
  146.     rsGLTransDetail("GL TRANSD Debit Amount") = 0
  147.     rsGLTransDetail("GL TRANSD Credit Amount") = rsBankTrans("BANK TRANS Amount")
  148.   rsGLTransDetail.Update
  149.  
  150.   AccountPost$ = rsBankTrans("BANK TRANS Bank Acct 2")
  151.   DebitAmount@ = 0
  152.   CreditAmount@ = rsBankTrans("BANK TRANS Amount")
  153.   Success% = PostCOA(AccountPost$, TranDate, DebitAmount@, CreditAmount@)
  154.   If Success% = False Then
  155.     MsgBox "An error occurred posting the transaction to the GL!", , "Error"
  156.     PostDeposit% = False
  157.     Exit Function
  158.   End If
  159.   
  160.   PostDeposit = True
  161.   rsCompany.Close
  162.   Set rsCompany = Nothing
  163.   rsGLWorkDetail.Close
  164.   Set rsGLWorkDetail = Nothing
  165.   rsBankTrans.Close
  166.   Set tsBankTrans = Nothing
  167.   rsGLTrans.Close
  168.   Set rsGLTrans = Nothing
  169.   rsGLTransDetail.Close
  170.   Set rsGLTransDetail = Nothing
  171.   db.Close
  172.   Set db = Nothing
  173.   
  174.   Exit Function
  175.  
  176. UnableToPostDepositHere:
  177.   PostDeposit = False
  178.   rsCompany.Close
  179.   Set rsCompany = Nothing
  180.   rsGLWorkDetail.Close
  181.   Set rsGLWorkDetail = Nothing
  182.   rsBankTrans.Close
  183.   Set tsBankTrans = Nothing
  184.   rsGLTrans.Close
  185.   Set rsGLTrans = Nothing
  186.   rsGLTransDetail.Close
  187.   Set rsGLTransDetail = Nothing
  188.   db.Close
  189.   Set db = Nothing
  190.   Exit Function
  191.  
  192. PostDeposit_Error:
  193.   Call ErrorLog("Bank Module", "PostDeposit", Now, Err.Number, Err.Description, True, db)
  194.   PostDeposit = False
  195.   rsCompany.Close
  196.   Set rsCompany = Nothing
  197.   rsGLWorkDetail.Close
  198.   Set rsGLWorkDetail = Nothing
  199.   rsBankTrans.Close
  200.   Set tsBankTrans = Nothing
  201.   rsGLTrans.Close
  202.   Set rsGLTrans = Nothing
  203.   rsGLTransDetail.Close
  204.   Set rsGLTransDetail = Nothing
  205.   db.Close
  206.   Set db = Nothing
  207.   Exit Function
  208.  
  209. End Function
  210.  
  211. Function PostReconciliation(db As ADODB.Connection) As Integer
  212. Dim Currentdb As Boolean
  213. Dim msg$
  214. Dim title$
  215.   
  216.   'Dim db As ADODB.Connection
  217.   Currentdb = False
  218.   If db Is Nothing Then
  219.     Set db = New ADODB.Connection
  220.     db.CursorLocation = adUseServer
  221.     db.Open gblADOProvider
  222.     Currentdb = True
  223.   End If
  224.  
  225.   'On Error GoTo PostReconciliation_Error
  226.   
  227.   Dim rsCompany As ADODB.Recordset
  228.   Set rsCompany = New ADODB.Recordset
  229.   rsCompany.Open "[SYS Company]", db, adOpenStatic, adLockOptimistic, adCmdTable
  230.   rsCompany.MoveFirst
  231.  
  232.   Dim rsGLWorkDetail As ADODB.Recordset
  233.   Set rsGLWorkDetail = New ADODB.Recordset
  234.   rsGLWorkDetail.Open "[GL Work Detail]", db, adOpenStatic, adLockOptimistic, adCmdTable
  235.  
  236.   Dim rsRec As ADODB.Recordset
  237.   Set rsRec = New ADODB.Recordset
  238.   rsRec.Open "[Bank Reconciliation]", db, adOpenStatic, adLockOptimistic, adCmdTable
  239.    rsRec.MoveFirst
  240.  
  241.   'Update Bank Reconciliation Detail Table from Credits & Debits
  242.    Dim qryBankRecDetailBuild As String
  243.    'qryBankRecDetailBuild = "INSERT INTO [BANK Reconciliation Detail] ( [BANK RECD Doc #], [BANK RECD Cleared], [BANK RECD Date], [BANK RECD Description], [BANK RECD Type], [BANK RECD Amount] )"
  244.    'qryBankRecDetailBuild = qryBankRecDetailBuild & " SELECT [qry___Bank_Rec_Detail].[Doc #], [qry___Bank_Rec_Detail].Cleared, [qry___Bank_Rec_Detail].Date, [qry___Bank_Rec_Detail].Description, [qry___Bank_Rec_Detail].Type, [qry___Bank_Rec_Detail].Amount"
  245.    'qryBankRecDetailBuild = qryBankRecDetailBuild & " FROM [qry___Bank_Rec_Detail]"
  246.    qryBankRecDetailBuild = "INSERT INTO [BANK Reconciliation Detail] ( [BANK RECD Doc #], [BANK RECD Cleared], [BANK RECD Date], [BANK RECD Description], [BANK RECD Type], [BANK RECD Amount] )"
  247.    qryBankRecDetailBuild = qryBankRecDetailBuild & " SELECT [qry - Bank Rec Detail].[Doc #], [qry - Bank Rec Detail].Cleared, [qry - Bank Rec Detail].Date, [qry - Bank Rec Detail].Description, [qry - Bank Rec Detail].Type, [qry - Bank Rec Detail].Amount"
  248.    qryBankRecDetailBuild = qryBankRecDetailBuild & " FROM [qry - Bank Rec Detail]"
  249.    
  250.    Dim cmdtemp As ADODB.Recordset
  251.    Set cmdtemp = New ADODB.Recordset
  252.    cmdtemp.Open qryBankRecDetailBuild, db, adOpenStatic, adLockOptimistic, adCmdText
  253.    'cmdtemp.Close
  254.    Set cmdtemp = Nothing
  255.  
  256.   'Post by 1 - system date or 2 - Transaction date?
  257.   Dim PostDate%
  258.   PostDate% = rsCompany("SYS COM GL Post By Date")
  259.  
  260.   'Set Post Date
  261.   Dim TranDate As Variant
  262.   If PostDate% = 1 Then
  263.     TranDate = DateValue(Format(Now, "Short Date"))
  264.   Else
  265.     TranDate = DateValue(IIf(IsNull(rsRec("BANK REC Cutoff Date")), Format(Now, "Short Date"), rsRec("BANK REC Cutoff Date")))
  266.   End If
  267.  
  268.   'Verify period can be posted to
  269.   'Send TranDate
  270.   'Return PeriodToPost and PeriodClosed
  271.   Dim PeriodToPost%
  272.   Dim PeriodClosed%
  273.   Call VerifyPeriod(TranDate, PeriodToPost%, PeriodClosed%, db)
  274.  
  275.   'Is period open?
  276.   If PeriodClosed% = True Then
  277.     MsgBox "Unable to post transaction to a closed period.", , "Post Invoice Error"
  278.     GoTo UnableToPostReconciliationHere
  279.   End If
  280.  
  281.   'On Error GoTo PostReconciliation_Error
  282.  
  283.   'clear any GL Work records
  284.   Dim cmdtemp2 As ADODB.Recordset
  285.   Set cmdtemp2 = New ADODB.Recordset
  286.   cmdtemp2.Open "DELETE DISTINCTROW * FROM [GL Work Detail]", db, , , adCmdText
  287.   'cmdtemp2.Close
  288.   Set cmdtemp2 = Nothing
  289.   
  290.   Dim rsGLTrans As ADODB.Recordset
  291.   Set rsGLTrans = New ADODB.Recordset
  292.   rsGLTrans.Open "[GL Transaction]", db, adOpenStatic, adLockOptimistic, adCmdTable
  293.  
  294.   Dim rsGLTransDetail As ADODB.Recordset
  295.   Set rsGLTransDetail = New ADODB.Recordset
  296.   rsGLTransDetail.Open "[GL Transaction Detail]", db, adOpenStatic, adLockOptimistic, adCmdTable
  297.  
  298.   'Mark all cleared records as closed
  299.   Dim rsRecDetail As ADODB.Recordset
  300.   Set rsRecDetail = New ADODB.Recordset
  301.   rsRecDetail.Open "[Bank Reconciliation Detail]", db, adOpenStatic, adLockOptimistic, adCmdTable
  302.  
  303.   If rsRecDetail.RecordCount < 1 Then GoTo skipclearing
  304.   rsRecDetail.MoveFirst
  305.   
  306.   Dim rsPaymentHeader As ADODB.Recordset
  307.   Set rsPaymentHeader = New ADODB.Recordset
  308.   rsPaymentHeader.Open "SELECT * [AP Payment Header] WHERE [AP PAY ID]='" & rsRecDetail("BANK RECD Doc #") & "'", db, adOpenStatic, adLockOptimistic, adCmdText
  309.   'rsPaymentHeader.Seek rsRecDetail("BANK RECD Description"), rsRecDetail("BANK RECD Doc #")
  310.   
  311.   Dim rsReceiptHeader As ADODB.Recordset
  312.   Set rsReceiptHeader = New ADODB.Recordset
  313.   rsReceiptHeader.Open "[AR Payment Header]", db, adOpenStatic, adLockOptimistic, adCmdTable
  314.   
  315.   Dim rsBankTrans As ADODB.Recordset
  316.   Set rsBankTrans = New ADODB.Recordset
  317.   rsBankTrans.Open "[Bank Transaction]", db, adOpenStatic, adLockOptimistic, adCmdTable
  318.  
  319.   Do While Not rsRecDetail.EOF
  320.     Select Case rsRecDetail("BANK RECD Type")
  321.     Case "Deposit", "Withdrawal", "Transfer From", "Transfer To", "Deposit Slip"
  322.       'rsBankTrans.Index = "BANK TRANS Ext Document No"
  323.       'rsBankTrans.Seek rsRecDetail("BANK RECD Doc #")
  324.       rsBankTrans.MoveFirst
  325.       rsBankTrans.Find "[BANK TRANS Ext Document No]='" & rsRecDetail("BANK RECD Doc #") & "'"
  326.       If rsBankTrans.EOF Then
  327.       Else
  328.         rsBankTrans("BANK TRANS Cleared YN") = True
  329.         rsBankTrans.Update
  330.       End If
  331.     Case "Payment", "Payroll", "Refund"
  332.       'rsPaymentHeader.Index = "PrimaryKey"
  333.       'rsPaymentHeader.Seek rsRecDetail("BANK RECD Description"), rsRecDetail("BANK RECD Doc #")
  334.       MsgBox "add find function rsRecDetail![BANK RECD Description]"
  335.       If rsPaymentHeader.EOF Then
  336.       Else
  337.         rsPaymentHeader("AP PAY Reconciled") = True
  338.         rsPaymentHeader.Update
  339.       End If
  340.     Case "Cash Receipt"
  341.       rsReceiptHeader.Index = "PrimaryKey"
  342.       rsReceiptHeader.Seek rsRecDetail("BANK RECD Description"), rsRecDetail("BANK RECD Doc #")
  343.       If rsReceiptHeader.EOF Then
  344.       Else
  345.         rsReceiptHeader("AR PAY Reconciled") = True
  346.         rsReceiptHeader.Update
  347.       End If
  348.     End Select
  349.     rsRecDetail.MoveNext
  350.   Loop
  351. skipclearing:
  352.  
  353. '------------------------------------------------------------------
  354.  
  355.   'Do Interest Earned
  356.   '                Debit   Credit    Source
  357.   '                -----   ------    ------
  358.   ' Bank Expense     X
  359.   ' Bank Account             X
  360.  
  361.   Dim NewNumber&
  362.   Dim CreditAmount@
  363.   Dim DebitAmount@
  364.   Dim AccountPost$
  365.   Dim Success%
  366.  
  367.   If (rsRec("BANK REC Interest") = 0) Then
  368.   Else
  369.     rsGLTrans.AddNew
  370.       NewNumber& = rsGLTrans("GL TRANS Number")
  371.       rsGLTrans("GL TRANS Document #") = "BANK REC " & Trim(Str(NewNumber&))
  372.       rsGLTrans("GL TRANS Type") = "BANK"
  373.       If PostDate% = 1 Then
  374.         rsGLTrans("GL TRANS Date") = Format(Now, "Short Date")
  375.       Else
  376.         rsGLTrans("GL TRANS Date") = rsRec("BANK REC Cutoff Date")
  377.       End If
  378.       rsGLTrans("GL TRANS Description") = "Interest Earned" '"Bank Reconciliation"
  379.       rsGLTrans("GL TRANS Reference") = rsRec("BANK REC Interest Acct")
  380.       rsGLTrans("GL TRANS Source") = "Bank Reconciliation"
  381.       rsGLTrans("GL TRANS Amount") = rsRec("BANK REC Interest")
  382.       rsGLTrans("GL TRANS Posted YN") = 1
  383.       rsGLTrans("GL TRANS System Generated") = True
  384.     rsGLTrans.Update
  385.  
  386.     rsGLTransDetail.AddNew
  387.       rsGLTransDetail("GL TRANSD Account") = rsRec("BANK REC Bank Acct")
  388.       rsGLTransDetail("GL TRANSD Debit Amount") = rsRec("BANK REC Interest")
  389.       rsGLTransDetail("GL TRANSD Credit Amount") = 0
  390.       rsGLTransDetail("GL TRANSD Number") = NewNumber&
  391.     rsGLTransDetail.Update
  392.  
  393.     AccountPost$ = rsRec("BANK REC Bank Acct")
  394.     DebitAmount@ = rsRec("BANK REC Interest")
  395.     CreditAmount@ = 0
  396.     Success% = PostCOA(AccountPost$, TranDate, DebitAmount@, CreditAmount@, db)
  397.     If Success% = False Then
  398.       MsgBox "An error occurred posting to the GL!", , "Error"
  399.       GoTo UnableToPostReconciliationHere
  400.     End If
  401.  
  402.     rsGLTransDetail.AddNew
  403.       rsGLTransDetail("GL TRANSD Account") = rsRec("BANK REC Interest Acct")
  404.       rsGLTransDetail("GL TRANSD Debit Amount") = 0
  405.       rsGLTransDetail("GL TRANSD Credit Amount") = rsRec("BANK REC Interest")
  406.       rsGLTransDetail("GL TRANSD Number") = NewNumber&
  407.     rsGLTransDetail.Update
  408.  
  409.     AccountPost$ = rsRec("BANK REC Interest Acct")
  410.     DebitAmount@ = 0
  411.     CreditAmount@ = rsRec("BANK REC Interest")
  412.     Success% = PostCOA(AccountPost$, TranDate, DebitAmount@, CreditAmount@, db)
  413.     If Success% = False Then
  414.       MsgBox "An error occurred posting to the GL!", , "Error"
  415.       GoTo UnableToPostReconciliationHere
  416.     End If
  417.  
  418.   End If
  419.  
  420. '------------------------------------------------------------------
  421.  
  422.   'Do Other Charges
  423.   '                Debit   Credit    Source
  424.   '                -----   ------    ------
  425.   ' Bank Expense     X
  426.   ' Bank Account             X
  427.  
  428.   If (rsRec("BANK REC Service Charge") = 0) Then
  429.   Else
  430.     rsGLTrans.AddNew
  431.       NewNumber& = rsGLTrans("GL TRANS Number")
  432.       rsGLTrans("GL TRANS Document #") = "BANK REC " & Trim(Str(NewNumber&))
  433.       rsGLTrans("GL TRANS Type") = "BANK"
  434.       If PostDate% = 1 Then
  435.         rsGLTrans("GL TRANS Date") = Format(Now, "Short Date")
  436.       Else
  437.         rsGLTrans("GL TRANS Date") = rsRec("BANK REC Cutoff Date")
  438.       End If
  439.       rsGLTrans("GL TRANS Description") = "Service Charge" '"Bank Reconciliation"
  440.       rsGLTrans("GL TRANS Reference") = rsRec("BANK REC Service Acct")
  441.       rsGLTrans("GL TRANS Source") = "Bank Reconciliation"
  442.       rsGLTrans("GL TRANS Amount") = rsRec("BANK REC Service Charge")
  443.       rsGLTrans("GL TRANS Posted YN") = 1
  444.       rsGLTrans("GL TRANS System Generated") = True
  445.     rsGLTrans.Update
  446.  
  447.     rsGLTransDetail.AddNew
  448.       rsGLTransDetail("GL TRANSD Account") = rsRec("BANK REC Service Acct")
  449.       rsGLTransDetail("GL TRANSD Debit Amount") = rsRec("BANK REC Service Charge")
  450.       rsGLTransDetail("GL TRANSD Credit Amount") = 0
  451.       rsGLTransDetail("GL TRANSD Number") = NewNumber&
  452.     rsGLTransDetail.Update
  453.  
  454.     AccountPost$ = rsRec("BANK REC Service Acct")
  455.     DebitAmount@ = rsRec("BANK REC Service Charge")
  456.     CreditAmount@ = 0
  457.     Success% = PostCOA(AccountPost$, TranDate, DebitAmount@, CreditAmount@, db)
  458.     If Success% = False Then
  459.       MsgBox "An error occurred posting to the GL!", , "Error"
  460.       GoTo UnableToPostReconciliationHere
  461.     End If
  462.  
  463.     rsGLTransDetail.AddNew
  464.       rsGLTransDetail("GL TRANSD Account") = rsRec("BANK REC Bank Acct")
  465.       rsGLTransDetail("GL TRANSD Debit Amount") = 0
  466.       rsGLTransDetail("GL TRANSD Credit Amount") = rsRec("BANK REC Service Charge")
  467.       rsGLTransDetail("GL TRANSD Number") = NewNumber&
  468.     rsGLTransDetail.Update
  469.  
  470.     AccountPost$ = rsRec("BANK REC Bank Acct")
  471.     DebitAmount@ = 0
  472.     CreditAmount@ = rsRec("BANK REC Service Charge")
  473.     Success% = PostCOA(AccountPost$, TranDate, DebitAmount@, CreditAmount@, db)
  474.     If Success% = False Then
  475.       MsgBox "An error occurred posting to the GL!", , "Error"
  476.       GoTo UnableToPostReconciliationHere
  477.     End If
  478.  
  479.   End If
  480.  
  481.   
  482.   PostReconciliation = True
  483.   
  484.     rsCompany.Close
  485.     Set rsCompany = Nothing
  486.     rsGLWorkDetail.Close
  487.     Set rsGLWorkDetail = Nothing
  488.     rsRec.Close
  489.     Set rsRecs = Nothing
  490.     rsGLTrans.Close
  491.     Set rsGLTrans = Nothing
  492.     rsGLTransDetail.Close
  493.     Set rsGLTransDetail = Nothing
  494.     rsRecDetail.Close
  495.     Set rsRecDetail = Nothing
  496.     'rsPaymentHeader.Close
  497.     Set rsPaymentHeader = Nothing
  498.     'rsReceiptHeader.Close
  499.     Set rsReceiptHeader = Nothing
  500.     'rsBankTrans.Close
  501.     Set rsBankTrans = Nothing
  502. If Currentdb = True Then
  503.     db.Close
  504.     Set db = Nothing
  505. End If
  506.  
  507.   Exit Function
  508.  
  509. UnableToPostReconciliationHere:
  510.   PostReconciliation = False
  511.     
  512.     rsCompany.Close
  513.     Set rsCompany = Nothing
  514.     rsGLWorkDetail.Close
  515.     Set rsGLWorkDetail = Nothing
  516.     rsRec.Close
  517.     Set rsRecs = Nothing
  518.     rsGLTrans.Close
  519.     Set rsGLTrans = Nothing
  520.     rsGLTransDetail.Close
  521.     Set rsGLTransDetail = Nothing
  522.     rsRecDetail.Close
  523.     Set rsRecDetail = Nothing
  524.     rsPaymentHeader.Close
  525.     Set rsPaymentHeader = Nothing
  526.     rsReceiptHeader.Close
  527.     Set rsReceiptHeader = Nothing
  528.     rsBankTrans.Close
  529.     Set rsBankTrans = Nothing
  530. If Currentdb = True Then
  531.     db.Close
  532.     Set db = Nothing
  533. End If
  534.   
  535.   Exit Function
  536.  
  537. PostReconciliation_Error:
  538.   Call ErrorLog("Bank Module", "PostReconciliation", Now, Err.Number, Err.Description, True, db)
  539.   PostReconciliation = False
  540.     
  541.     rsCompany.Close
  542.     Set rsCompany = Nothing
  543.     rsGLWorkDetail.Close
  544.     Set rsGLWorkDetail = Nothing
  545.     rsRec.Close
  546.     Set rsRecs = Nothing
  547.     rsGLTrans.Close
  548.     Set rsGLTrans = Nothing
  549.     rsGLTransDetail.Close
  550.     Set rsGLTransDetail = Nothing
  551.     rsRecDetail.Close
  552.     Set rsRecDetail = Nothing
  553.     rsPaymentHeader.Close
  554.     Set rsPaymentHeader = Nothing
  555.     rsReceiptHeader.Close
  556.     Set rsReceiptHeader = Nothing
  557.     rsBankTrans.Close
  558.     Set rsBankTrans = Nothing
  559. If Currentdb = True Then
  560.     db.Close
  561.     Set db = Nothing
  562. End If
  563.   
  564.   Exit Function
  565.  
  566. End Function
  567.  
  568. Function PostTransfer(DocumentKey&) As Integer
  569.  
  570.   'On Error GoTo PostTransfer_Error
  571.  
  572.   Dim msg$
  573.   Dim title$
  574.  
  575.   Dim db As ADODB.Connection
  576.   Set db = New ADODB.Connection
  577.   db.CursorLocation = adUseServer
  578.   db.Open gblADOProvider
  579.   Dim rsCompany As ADODB.Recordset
  580.   Set rsCompany = New ADODB.Recordset
  581.   rsCompany.Open "[SYS Company]", db, adOpenStatic, adLockOptimistic, adCmdTable
  582.   rsCompany.MoveFirst
  583.  
  584.   Dim rsGLWorkDetail As ADODB.Recordset
  585.   Set rsGLWorkDetail = New ADODB.Recordset
  586.   rsGLWorkDetail.Open "[GL Work Detail]", db, adOpenStatic, adLockOptimistic, adCmdTable
  587.     
  588.   Dim rsBankTrans As ADODB.Recordset
  589.   Set rsBankTrans = New ADODB.Recordset
  590.   rsBankTrans.Open "[BANK Transaction]", db, adOpenStatic, adLockOptimistic, adCmdTable
  591.   
  592.   ' first lets get the Credit Memo
  593.   'rsBankTrans.Index = "PrimaryKey"
  594.   'rsBankTrans.Seek DocumentKey&
  595.   rsBankTrans.MoveFirst
  596.   rsBankTrans.Find "[BANK TRANS ID]=" & DocumentKey&
  597.  
  598.   'Post by 1 - system date or 2 - Transaction date?
  599.   Dim PostDate%
  600.   PostDate% = rsCompany("SYS COM GL Post By Date")
  601.  
  602.   'Set Post Date
  603.   Dim TranDate As Variant
  604.   If PostDate% = 1 Then
  605.     TranDate = DateValue(Format(Now, "Short Date"))
  606.   Else
  607.     TranDate = DateValue(rsBankTrans("BANK TRANS Date"))
  608.   End If
  609.  
  610.   'Verify period can be posted to
  611.   'Send TranDate
  612.   'Return PeriodToPost and PeriodClosed
  613.   Dim PeriodToPost%
  614.   Dim PeriodClosed%
  615.   Call VerifyPeriod(TranDate, PeriodToPost%, PeriodClosed%, db)
  616.   
  617.   'Is period open?
  618.   If PeriodClosed% = True Then
  619.     MsgBox "Unable to post transaction to a closed period.", , "Post Invoice Error"
  620.     GoTo UnableToPostTransferHere
  621.   End If
  622.  
  623.   'On Error GoTo PostTransfer_Error
  624.  
  625.   ' clear any GL Work records
  626.   Dim cmdtemp As ADODB.Recordset
  627.   Set cmdtemp = New ADODB.Recordset
  628.   cmdtemp.Open "DELETE DISTINCTROW * FROM [GL Work Detail]", db, , , adCmdText
  629.   'cmdtemp.Close
  630.   Set cmdtemp = Nothing
  631.     
  632.   Dim rsGLTrans As ADODB.Recordset
  633.   Set rsGLTrans = New ADODB.Recordset
  634.   rsGLTrans.Open "[GL Transaction]", db, adOpenStatic, adLockOptimistic, adCmdTable
  635.   
  636.   ' write GL Transaction Header
  637.   Dim refr$
  638.   Dim desc$
  639.   Dim NewNumber&
  640.   rsGLTrans.AddNew
  641.     
  642.     rsGLTrans("GL TRANS Document #") = "TRFR " & rsBankTrans("BANK TRANS Ext Document No")
  643.     
  644.     ' gl post date
  645.     If PostDate% = 1 Then
  646.       rsGLTrans("GL TRANS Date") = Format(Now, "Short Date")
  647.     Else
  648.       rsGLTrans("GL TRANS Date") = rsBankTrans("BANK TRANS Date")
  649.     End If
  650.     
  651.     rsGLTrans("GL TRANS Type") = "Transfer"
  652.  
  653.     refr$ = IIf(IsNull(rsBankTrans("BANK TRANS Reference")), "", rsBankTrans("BANK TRANS Reference"))
  654.     
  655.     rsGLTrans("GL TRANS Reference") = refr$
  656.     rsGLTrans("GL TRANS Amount") = rsBankTrans("BANK TRANS Amount")
  657.     rsGLTrans("GL TRANS Posted YN") = 1
  658.     desc$ = refr$
  659.     If Len(Trim$(desc$)) = 0 Then
  660.       desc$ = "TRFR " & rsBankTrans("BANK TRANS Ext Document No")
  661.     End If
  662.     rsGLTrans("GL TRANS Description") = desc$
  663.     rsGLTrans("GL TRANS Source") = "TRFR " & rsBankTrans("BANK TRANS Ext Document No")
  664.     rsGLTrans("GL TRANS System Generated") = True
  665.   rsGLTrans.Update
  666.   NewNumber& = rsGLTrans("GL TRANS Number")
  667.  
  668.   Dim rsGLTransDetail As ADODB.Recordset
  669.   Set rsGLTransDetail = New ADODB.Recordset
  670.   rsGLTransDetail.Open "[GL Transaction Detail]", db, adOpenStatic, adLockOptimistic, adCmdTable
  671.   
  672.   rsGLTransDetail.AddNew
  673.     rsGLTransDetail("GL TRANSD Number") = NewNumber&
  674.     rsGLTransDetail("GL TRANSD Account") = rsBankTrans("BANK TRANS Bank Acct 2")
  675.     rsGLTransDetail("GL TRANSD Debit Amount") = rsBankTrans("BANK TRANS Amount")
  676.     rsGLTransDetail("GL TRANSD Credit Amount") = 0
  677.   rsGLTransDetail.Update
  678.  
  679.   Dim AccountPost$
  680.   Dim DebitAmount@
  681.   Dim CreditAmount@
  682.   Dim Success%
  683.   
  684.   AccountPost$ = rsBankTrans("BANK TRANS Bank Acct 2")
  685.   DebitAmount@ = rsBankTrans("BANK TRANS Amount")
  686.   CreditAmount@ = 0
  687.   Success% = PostCOA(AccountPost$, TranDate, DebitAmount@, CreditAmount@)
  688.   If Success% = False Then
  689.     MsgBox "An error occurred posting the transaction to the GL!", , "Error"
  690.     PostTransfer = False
  691.     Exit Function
  692.   End If
  693.  
  694.   rsGLTransDetail.AddNew
  695.     rsGLTransDetail("GL TRANSD Number") = NewNumber&
  696.     rsGLTransDetail("GL TRANSD Account") = rsBankTrans("BANK TRANS Bank Acct 1")
  697.     rsGLTransDetail("GL TRANSD Debit Amount") = 0
  698.     rsGLTransDetail("GL TRANSD Credit Amount") = rsBankTrans("BANK TRANS Amount")
  699.   rsGLTransDetail.Update
  700.  
  701.   AccountPost$ = rsBankTrans("BANK TRANS Bank Acct 1")
  702.   DebitAmount@ = 0
  703.   CreditAmount@ = rsBankTrans("BANK TRANS Amount")
  704.   Success% = PostCOA(AccountPost$, TranDate, DebitAmount@, CreditAmount@)
  705.   If Success% = False Then
  706.     MsgBox "An error occurred posting the transaction to the GL!", , "Error"
  707.     PostTransfer = False
  708.     Exit Function
  709.   End If
  710.   
  711.   
  712.   'Create a cloned record of type Transfer To and reverse the accounts
  713.  
  714.   Dim rs As ADODB.Recordset
  715.   Dim rs2 As ADODB.Recordset
  716.   Set rs = New ADODB.Recordset
  717.   rs.Open "[Bank Transaction]", db, adOpenStatic, adLockOptimistic, adCmdTable
  718.   Set rs2 = New ADODB.Recordset
  719.   rs2.Open "[Bank Transaction]", db, adOpenStatic, adLockOptimistic, adCmdTable
  720.  
  721.   'rs.Index = "PrimaryKey"
  722.   'rs.Seek DocumentKey&
  723.   rs.MoveFirst
  724.   rs.Find "[BANK TRANS ID]=" & DocumentKey&
  725.  
  726.   Dim MyCounter&
  727.   Dim MyCounter2&
  728.  
  729.   MyCounter& = DocumentKey&
  730.  
  731.   'On Error Resume Next
  732.  
  733.   Dim X%
  734.   Dim count%
  735.   count% = rs2.Fields.count
  736.   rs2.AddNew
  737.     'Add all current rs records
  738.     'MyCounter2& = rs2("BANK TRANS ID")
  739.     For X% = 1 To count% - 1
  740.     If IsNull(rs(X%)) = False Then
  741.       If rs2(X%).Type = 202 Or rs2(X%).Type = 203 Then
  742.         rs2(X%) = rs(X%) & ""
  743.       Else
  744.         rs2(X%) = rs(X%)
  745.       End If
  746.     End If
  747.     Next X%
  748.  
  749.     'rs2("BANK TRANS ID") = MyCounter2&
  750.     'Create an invoice ID
  751.     Dim rsSeek As ADODB.Recordset
  752.     Set rsSeek = New ADODB.Recordset
  753.     rsSeek.Open "[Bank Transaction]", db, adOpenStatic, adLockOptimistic, adCmdTable
  754.     'rsSeek.Index = "BANK TRANS Ext Document No"
  755.     Dim Counter%
  756.     Counter% = 1
  757.     Success% = False
  758.     Do While Not Success%
  759.       gNewInvoice$ = rs2("BANK TRANS Ext Document No") & "-" & Trim(Str(Counter%))
  760.       'Check if this newly created document exists
  761.       rsSeek.MoveFirst
  762.       rsSeek.Find "[BANK TRANS Ext Document No]='" & gNewInvoice$ & "'"
  763.       If rsSeek.EOF Then
  764.         Success% = True
  765.       Else
  766.         Success% = False
  767.         Counter% = Counter% + 1
  768.       End If
  769.     Loop
  770.     rs2("BANK TRANS Ext Document No") = gNewInvoice$
  771.     rs2("BANK TRANS Posted YN") = True
  772.     Dim Holder$
  773.     Holder$ = rs2("BANK TRANS Bank Acct 1")
  774.     rs2("BANK TRANS Bank Acct 1") = rs2("BANK TRANS Bank Acct 2")
  775.     rs2("BANK TRANS Bank Acct 2") = Holder$
  776.     rs2("BANK TRANS Type") = "Transfer To"
  777.   rs2.Update
  778.  
  779.   PostTransfer = True
  780.   
  781.   rs.Close
  782.   Set rs = Nothing
  783.   rs2.Close
  784.   Set rs2 = Nothing
  785.   rsCompany.Close
  786.   Set rsCompany = Nothing
  787.   rsSeek.Close
  788.   Set rsSeek = Nothing
  789.   rsGLTrans.Close
  790.   Set rsGLTrans = Nothing
  791.   rsGLTransDetail.Close
  792.   Set rsGLTransDetail = Nothing
  793.   rsGLWorkDetail.Close
  794.   Set rsGLWorkDetail = Nothing
  795.   rsBankTrans.Close
  796.   Set rsBankTrans = Nothing
  797.   db.Close
  798.   Set db = Nothing
  799.   
  800.   Exit Function
  801.  
  802. UnableToPostTransferHere:
  803.   PostTransfer = False
  804.    rs.Close
  805.   Set rs = Nothing
  806.   rs2.Close
  807.   Set rs2 = Nothing
  808.   rsCompany.Close
  809.   Set rsCompany = Nothing
  810.   rsSeek.Close
  811.   Set rsSeek = Nothing
  812.   rsGLTrans.Close
  813.   Set rsGLTrans = Nothing
  814.   rsGLTransDetail.Close
  815.   Set rsGLTransDetail = Nothing
  816.   rsGLWorkDetail.Close
  817.   Set rsGLWorkDetail = Nothing
  818.   rsBankTrans.Close
  819.   Set rsBankTrans = Nothing
  820.   db.Close
  821.   Set db = Nothing
  822.   Exit Function
  823.  
  824. PostTransfer_Error:
  825.   Call ErrorLog("Bank Module", "PostTransfer", Now, Err.Number, Err.Description, True, db)
  826.   PostTransfer = False
  827.     rs.Close
  828.   Set rs = Nothing
  829.   rs2.Close
  830.   Set rs2 = Nothing
  831.   rsCompany.Close
  832.   Set rsCompany = Nothing
  833.   rsSeek.Close
  834.   Set rsSeek = Nothing
  835.   rsGLTrans.Close
  836.   Set rsGLTrans = Nothing
  837.   rsGLTransDetail.Close
  838.   Set rsGLTransDetail = Nothing
  839.   rsGLWorkDetail.Close
  840.   Set rsGLWorkDetail = Nothing
  841.   rsBankTrans.Close
  842.   Set rsBankTrans = Nothing
  843.   db.Close
  844.   Set db = Nothing
  845.   Exit Function
  846.  
  847.  
  848. End Function
  849.  
  850. Function PostWithdrawal(DocumentKey&) As Integer
  851.  
  852.   'On Error GoTo PostWithdrawal_Error
  853.  
  854.   Dim msg$
  855.   Dim title$
  856.   
  857.   Dim db As ADODB.Connection
  858.   Set db = New ADODB.Connection
  859.   db.CursorLocation = adUseServer
  860.   db.Open gblADOProvider
  861.   
  862.   Dim rsCompany As ADODB.Recordset
  863.   Set rsCompany = New ADODB.Recordset
  864.   rsCompany.Open "[SYS Company]", db, adOpenStatic, adLockOptimistic, adCmdTable
  865.   
  866.   rsCompany.MoveFirst
  867.  
  868.   Dim rsGLWorkDetail As ADODB.Recordset
  869.   Set rsGLWorkDetail = New ADODB.Recordset
  870.   rsGLWorkDetail.Open "[GL Work Detail]", db, adOpenStatic, adLockOptimistic, adCmdTable
  871.   
  872.   Dim rsBankTrans As ADODB.Recordset
  873.   Set rsBankTrans = New ADODB.Recordset
  874.   rsBankTrans.Open "[BANK Transaction]", db, adOpenStatic, adLockOptimistic, adCmdTable
  875.  
  876.   ' first lets get the Credit Memo
  877.   'rsBankTrans.Index = "PrimaryKey"
  878.   'rsBankTrans.Seek DocumentKey&
  879.   rsBankTrans.MoveFirst
  880.   rsBankTrans.Find "[BANK TRANS ID]=" & DocumentKey&
  881.  
  882.   'Post by 1 - system date or 2 - Transaction date?
  883.   Dim PostDate%
  884.   PostDate% = rsCompany("SYS COM GL Post By Date")
  885.  
  886.   'Set Post Date
  887.   Dim TranDate As Variant
  888.   If PostDate% = 1 Then
  889.     TranDate = DateValue(Format(Now, "Short Date"))
  890.   Else
  891.     TranDate = DateValue(rsBankTrans("BANK TRANS Date"))
  892.   End If
  893.  
  894.   'Verify period can be posted to
  895.   'Send TranDate
  896.   'Return PeriodToPost and PeriodClosed
  897.   Dim PeriodToPost%
  898.   Dim PeriodClosed%
  899.   Call VerifyPeriod(TranDate, PeriodToPost%, PeriodClosed%, db)
  900.   
  901.   'Is period open?
  902.   If PeriodClosed% = True Then
  903.     MsgBox "Unable to post transaction to a closed period.", , "Post Invoice Error"
  904.     GoTo UnableToPostWithdrawalHere
  905.   End If
  906.  
  907.   'On Error GoTo PostWithdrawal_Error
  908.  
  909.   ' clear any GL Work records
  910.   Dim cmdtemp As ADODB.Recordset
  911.   Set cmdtemp = New ADODB.Recordset
  912.   cmdtemp.Open "DELETE DISTINCTROW * FROM [GL Work Detail]", db, , , adCmdText
  913.   'cmdtemp.Close
  914.   Set cmdtemp = Nothing
  915.   
  916.   Dim rsGLTrans As ADODB.Recordset
  917.   Set rsGLTrans = New ADODB.Recordset
  918.   rsGLTrans.Open "[GL Transaction]", db, adOpenStatic, adLockOptimistic, adCmdTable
  919.     
  920.   ' write GL Transaction Header
  921.   Dim refr$
  922.   Dim desc$
  923.   Dim NewNumber&
  924.   rsGLTrans.AddNew
  925.     
  926.     rsGLTrans("GL TRANS Document #") = "WDRL " & rsBankTrans("BANK TRANS Ext Document No")
  927.     
  928.     ' gl post date
  929.     If PostDate% = 1 Then
  930.       rsGLTrans("GL TRANS Date") = Format(Now, "Short Date")
  931.     Else
  932.       rsGLTrans("GL TRANS Date") = rsBankTrans("BANK TRANS Date")
  933.     End If
  934.     
  935.     rsGLTrans("GL TRANS Type") = "Withdrawal"
  936.  
  937.     refr$ = IIf(IsNull(rsBankTrans("BANK TRANS Reference")), "", rsBankTrans("BANK TRANS Reference"))
  938.     
  939.     rsGLTrans("GL TRANS Reference") = refr$
  940.     rsGLTrans("GL TRANS Amount") = rsBankTrans("BANK TRANS Amount")
  941.     rsGLTrans("GL TRANS Posted YN") = 1
  942.     desc$ = refr$
  943.     If Len(Trim$(desc$)) = 0 Then
  944.       desc$ = "WDRL " & rsBankTrans("BANK TRANS Ext Document No")
  945.     End If
  946.     rsGLTrans("GL TRANS Description") = desc$
  947.     rsGLTrans("GL TRANS Source") = "WDRL " & rsBankTrans("BANK TRANS Ext Document No")
  948.     rsGLTrans("GL TRANS System Generated") = True
  949.   rsGLTrans.Update
  950.   NewNumber& = rsGLTrans("GL TRANS Number")
  951.   
  952.  
  953. '                 Debit   Credit    Source
  954. '                 -----   ------    ------
  955. ' Lookup Selection  X               txtWithdrawlAcct$
  956. ' Bank Account              X       cboBank.text
  957.  
  958.  
  959.   Dim rsGLTransDetail As ADODB.Recordset
  960.   Set rsGLTransDetail = New ADODB.Recordset
  961.   rsGLTransDetail.Open "[GL Transaction Detail]", db, adOpenStatic, adLockOptimistic, adCmdTable
  962.   
  963.   rsGLTransDetail.AddNew
  964.     rsGLTransDetail("GL TRANSD Number") = NewNumber&
  965.     rsGLTransDetail("GL TRANSD Account") = rsBankTrans("BANK TRANS Bank Acct 1")
  966.     rsGLTransDetail("GL TRANSD Debit Amount") = 0
  967.     rsGLTransDetail("GL TRANSD Credit Amount") = rsBankTrans("BANK TRANS Amount")
  968.   rsGLTransDetail.Update
  969.       
  970.  
  971.   Dim AccountPost$
  972.   Dim DebitAmount@
  973.   Dim CreditAmount@
  974.   Dim Success%
  975.    As ADODB.Recordset
  976.   Set cmdtemp = New ADODB.Recordset
  977.   cmdtemp.Open "DELETE DISTINCTROW * FROM [GL Work Detail]", db, , , adCmdText
  978.   'cmdtemp.Close
  979.   Set cmdtemp = Nothing
  980.     
  981.   Dim rsGLTrans As ADODB.Recordset
  982.   Set rsGLTrans = New ADODB.RecordsLookup Selection  ansDetail("Selection  ansDetail("Selection  ansDetail("Selection  ansDetail("Select_DODBe
  983.   temp.Cyo ansDeta ansDet New ADODy rsGLTransDetail("GL TRANSD Debit rsGLANSD Debit cEransL TRANSD Dgrs2(Xy rsGLTransDetail("GL TRPostWitGLTrance"))
  984.     
  985.  ") = NewNumber&
  986.     rsGLTransDetail("GL TRANSD Account") = rsBankTrans(("GL A.sBankTrans(("GnsL TR cmdtemp As ADO = New ADODB.RecordsLookup Selectioourred posting th]"ODB