日记帐.frm

用友u8财务源码,用visual basic开发

      Next i
   End With

End Sub

Private Function AccOpenDate(cAccID As String) As Date
   'CuiDong Efficiency-A 2000/06/19 效率优化A OK
   Dim rsTmp As New UfRecordset
'   Set rsTmp = dbsZJ.OpenRecordset("FD_AccDef", dbOpenDynaset)  'CuiDong Efficiency-A 2000/06/19 效率优化A
   Set rsTmp = dbsZJ.OpenRecordset("Select dOpenDate From FD_AccDef Where cAccID = '" & cAccID & "'", dbOpenDynaset)    'CuiDong Efficiency-A 2000/06/19 效率优化A
   With rsTmp
'      .FindFirst "cAccID = '" & cAccID & "'"                    'CuiDong Efficiency-A 2000/06/19 效率优化A
'      If Not .NoMatch Then                                      'CuiDong Efficiency-A 2000/06/19 效率优化A
      If Not (.EOF Or .BOF) Then                                                                                'CuiDong Efficiency-A 2000/06/19 效率优化A
         AccOpenDate = !dOpenDate
      End If
   End With
End Function

'%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
'%函数说明: 对于只包含一个账户的单据，作标记并归集总账                 %
'%参    数: strTable-单据表                                          %
'%          bPlus：True-加; False-减                                 %
'%返回值  :                                                         %
'%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
Private Sub SendToFD_Accsum(strTable As String, bPlus As Boolean)
   Dim sqlTemp As String
   Dim rsTemp As New UfRecordset
   Dim i As Integer
   Dim SQL As String
   Dim bAsign As String
   Dim sqlSub As String
   Dim rsSub As New UfRecordset
   Dim con As New ADODB.Connection
   Dim rec As New ADODB.Recordset
   
   If bPlus Then
      bAsign = "+"
   Else
      bAsign = "-"
   End If
   sqlTemp = "SELECT * FROM " & strTable & " WHERE cBookCode IS NULL AND cCheckCode IS NOT NULL"
   Set rsTemp = dbsZJ.OpenRecordset(sqlTemp, dbOpenDynaset)
   On Error GoTo lblErr
   dbsZJ.BeginTrans
   With rsTemp
      If Not .EOF Then
         .MoveLast
         Me.ProgressBar1.Max = rsTemp.RecordCount
         .MoveFirst
      End If
      While Not .EOF
         Dim blnPutZz As Boolean
         Dim dOpen As Date
         dOpen = AccOpenDate(!cAccID)
         dOpen = IIf(ZjAccInfo.zjStartdate < dOpen, dOpen, ZjAccInfo.zjStartdate) '----zcl add
         ChangeStatus mID(.Fields(iNoField).Value, 3), 1
         If !dbill_date <= dDate Then
            sqlSub = "SELECT iDataSrc FROM FD_AccDef WHERE cAccID='" & !cAccID & "'"
            Set rsSub = dbsZJ.OpenRecordset(sqlSub, dbOpenSnapshot)
            If rsSub!iDataSrc = 1 Then GoTo lblBook
            If !dbill_date >= dOpen Then  '账户启用前的单据不记入总账
               If (strTable = "FD_Sav" Or strTable = "FD_Fetch") Then
                  If !isc = 0 Then
                     blnPutZz = False
                  Else
                     blnPutZz = True
                  End If
               Else
                  blnPutZz = True
               End If
               If blnPutZz Then
                  SQL = "UPDATE FD_AccSum SET mb = mb" & bAsign & !mMoney & _
                        ", mh = mh " & bAsign & Format(!mMoney, "#0.00") & " * (DateDiff(Day, '" & FormatDate(!dbill_date) & "', dbill_date) + 1)" & _
                        " WHERE dbill_date >= '" & FormatDate(!dbill_date) & "' AND cAccID ='" & !cAccID & "'"
                  dbsZJ.Execute SQL
               End If
            End If
lblBook:
            con.Open g_sDataSourceName
            SQL = "select book_name from fd_transactions where transactions_id='" & !transactions_id & "'"
            rec.Open SQL, con, adOpenDynamic, adLockOptimistic
            rec!book_name = zjLogInfo.cUserName
            rec.Update
            rec.Close
            con.Close
         End If
         .MoveNext
      Wend
   End With
   dbsZJ.CommitTrans
   Exit Sub
lblErr:
   dbsZJ.Rollback
End Sub

'%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
'%函数说明: 对于包含两个账户的单据，作标记并归集总账                  %
'%参    数: strTable-单据表                                          %
'%                                                                   %
'%返回值  :                                                         %
'%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
Private Sub SendUnwToFD_Accsum(strTable As String)
   Dim sqlTemp As String
   Dim rsTemp As New UfRecordset
   Dim i As Integer
   Dim SQL As String
   Dim bAsign As String
   Dim blnAcc As Boolean
   Dim sqlSub As String
   Dim rsSub As New UfRecordset
   Dim dOpen As Date
   Dim con As New ADODB.Connection
   Dim rec As New ADODB.Recordset
   
   sqlTemp = "SELECT * FROM " & strTable & " WHERE cBookCode IS NULL AND cCheckCode IS NOT NULL"
   Set rsTemp = dbsZJ.OpenRecordset(sqlTemp, dbOpenDynaset)
   On Error GoTo lblErr
   dbsZJ.BeginTrans
   With rsTemp
      If Not .EOF Then
         .MoveLast
         Me.ProgressBar1.Max = rsTemp.RecordCount
         .MoveFirst
      End If
      While Not .EOF
         ChangeStatus mID(.Fields(iNoField).Value, 3), 1
         If !dbill_date <= dDate Then
            If strTable = "FD_CadAcr" Then
               If !iDanType = 0 Then
                  blnAcc = True
               Else
                  blnAcc = False
               End If
            Else
               blnAcc = True
            End If
            If Not IsNull(!cGAccID) Then
               dOpen = AccOpenDate(!cGAccID)
               dOpen = IIf(ZjAccInfo.zjStartdate < dOpen, dOpen, ZjAccInfo.zjStartdate) '----zcl add
            Else
               GoTo Next1
            End If
            If !dbill_date >= dOpen And blnAcc Then  '账户启用前的单据不记入总账
               sqlSub = "SELECT iDataSrc FROM FD_AccDef WHERE cAccID='" & !cGAccID & "'"
               Set rsSub = dbsZJ.OpenRecordset(sqlSub, dbOpenSnapshot)
               If Not rsSub.EOF Then
                  If rsSub!iDataSrc = 0 Then
                     SQL = "UPDATE FD_AccSum SET mb = mb + " & !mMoney & _
                        ", mh = mh + " & Format(!mMoney, "#0.00") & " * (DateDiff(Day, '" & FormatDate(!dbill_date) & "', dbill_date) + 1)" & _
                        " WHERE dbill_date>='" & FormatDate(!dbill_date) & "' AND cAccID='" & !cGAccID & "'"
                     dbsZJ.Execute SQL
                  End If
               End If
            End If
Next1:
            If Not IsNull(!cPAccID) Then
               dOpen = AccOpenDate(!cPAccID)
               dOpen = IIf(ZjAccInfo.zjStartdate < dOpen, dOpen, ZjAccInfo.zjStartdate) '----zcl add
            Else
               GoTo Next2
            End If
            If !dbill_date >= dOpen And blnAcc Then  '账户启用前的单据不记入总账
               sqlSub = "SELECT iDataSrc FROM FD_AccDef WHERE cAccID='" & !cPAccID & "'"
               Set rsSub = dbsZJ.OpenRecordset(sqlSub, dbOpenSnapshot)
               If Not rsSub.EOF Then
                  If rsSub!iDataSrc = 0 Then
                     SQL = "UPDATE FD_AccSum SET mb = mb - " & !mMoney & _
                        ", mh = mh - " & Format(!mMoney, "#0.00") & " * (DateDiff(Day, '" & FormatDate(!dbill_date) & "', dbill_date) + 1)" & _
                        " WHERE dbill_date >= '" & FormatDate(!dbill_date) & "' AND cAccID = '" & !cPAccID & "'"
                     dbsZJ.Execute SQL
                  End If
               End If
            End If
Next2:
            con.Open g_sDataSourceName
            SQL = "select book_name from fd_transactions where transactions_id='" & !transactions_id & "'"
            rec.Open SQL, con, adOpenDynamic, adLockOptimistic
            rec!book_name = zjLogInfo.cUserName
            rec.Update
            rec.Close
            con.Close
            .Bookmark = .LastModified
         End If
         .MoveNext
      Wend
   End With
   dbsZJ.CommitTrans
   Exit Sub
lblErr:
   dbsZJ.Rollback
End Sub

'%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
'%函数说明: 对于结算单据，作标记并归集总账                             %
'%参    数: strTable-单据表                                           %
'%                                                                   %
'%返回值  :                                                          %
'%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
Private Sub SendJsToFD_Accsum(strTable As String)
   Dim sqlTemp As String
   Dim rsTemp As New UfRecordset
   Dim SQL As String
   Dim bAsign As String
   Dim sqlSub As String
   Dim rsSub As New UfRecordset
   Dim dOpen As Date
   Dim con As New ADODB.Connection
   Dim rec As New ADODB.Recordset
   
   sqlTemp = "SELECT * FROM " & strTable & " WHERE cBookCode IS NULL AND cCheckCode IS NOT NULL"
   Set rsTemp = dbsZJ.OpenRecordset(sqlTemp, dbOpenDynaset)
   On Error GoTo lblErr
   dbsZJ.BeginTrans
   With rsTemp
      If Not .EOF Then
         .MoveLast
         Me.ProgressBar1.Max = rsTemp.RecordCount
         .MoveFirst
      End If
      While Not .EOF
         ChangeStatus mID(.Fields(iNoField).Value, 3), 1
         If !dbill_date <= dDate Then
            dOpen = AccOpenDate(!cGAccID)
            dOpen = IIf(ZjAccInfo.zjStartdate < dOpen, dOpen, ZjAccInfo.zjStartdate) '----zcl add
            If !dbill_date >= dOpen Then  '账户启用前的单据不记入总账
               sqlSub = "SELECT iDataSrc FROM FD_AccDef WHERE cAccID='" & !cGAccID & "'"
               Set rsSub = dbsZJ.OpenRecordset(sqlSub, dbOpenSnapshot)
               If Not rsSub.EOF Then
                  If rsSub!iDataSrc = 0 Then
                     If Left(!cSetid, 2) = "14" Then   '对外结算单
                        bAsign = IIf(!igp_flag = 0, "+", "-")
                     Else
                        bAsign = "+"
                     End If
                     SQL = "UPDATE FD_AccSum SET mb = mb" & bAsign & !mMoney & _
                        ", mh = mh" & bAsign & Format(!mMoney, "#0.00") & " * (DateDiff(Day, '" & FormatDate(!dbill_date) & "', dbill_date) + 1)" & _
                        " WHERE dbill_date >= '" & FormatDate(!dbill_date) & "' AND cAccID = '" & !cGAccID & "'"
                     dbsZJ.Execute SQL
                  End If
               End If
            End If
            dOpen = AccOpenDate(!cPAccID)
            dOpen = IIf(ZjAccInfo.zjStartdate < dOpen, dOpen, ZjAccInfo.zjStartdate) '----zcl add
            If !dbill_date >= dOpen Then  '账户启用前的单据不记入总账
               sqlSub = "SELECT iDataSrc FROM FD_AccDef WHERE cAccID='" & !cPAccID & "'"
               Set rsSub = dbsZJ.OpenRecordset(sqlSub, dbOpenSnapshot)
               If Not rsSub.EOF Then
                  If rsSub!iDataSrc = 0 Then
                     If Left(!cSetid, 2) = "14" Then   '对外结算单
                        bAsign = IIf(!igp_flag = 0, "+", "-")
                     Else
                        bAsign = "-"
                     End If
                     SQL = "UPDATE FD_AccSum SET mb = mb" & bAsign & !mMoney & _
                        ", mh = mh" & bAsign & Format(!mMoney, "#0.00") & " * (DateDiff(Day, '" & FormatDate(!dbill_date) & "', dbill_date) + 1)" & _
                        " WHERE dbill_date >= '" & FormatDate(!dbill_date) & "' AND cAccID = '" & !cPAccID & "'"
                     dbsZJ.Execute SQL
                  End If
               End If
            End If
            con.Open g_sDataSourceName
            SQL = "select book_name from fd_transactions where transactions_id='" & !transactions_id & "'"
            rec.Open SQL, con, adOpenDynamic, adLockOptimistic
            rec!book_name = zjLogInfo.cUserName
            rec.Update
            rec.Close
            con.Close
            .Bookmark = .LastModified
         End If
         .MoveNext
      Wend
   End With
   dbsZJ.CommitTrans
   Exit Sub
lblErr:
   dbsZJ.Rollback
End Sub

Private Sub CheckedPages()
   Dim rsTemp  As New UfRecordset
   Dim sAll    As String
   
   lngChecked = 0
   lngUncheck = 0
   
   sAll = "SELECT Sum(Case When cCheckCode Is Null Then 0 Else 1 End) AS iChecked, Sum(Case When cCheckCode Is Null Then 1 Else 0 End) AS iUnChecked " & _
      "FROM FD_Cred WHERE cBookCode IS NULL "
   sAll = sAll & "UNION ALL SELECT Sum(Case When cCheckCode Is Null Then 0 Else 1 End), Sum(Case When cCheckCode Is Null Then 1 Else 0 End)" & _
      " FROM FD_Return WHERE cBookCode IS NULL "
   sAll = sAll & "UNION ALL SELECT Sum(Case When cCheckCode Is Null Then 0 Else 1 End), Sum(Case When cCheckCode Is Null Then 1 Else 0 End)" & _
      " FROM FD_CreAcrRcp WHERE cBookCode IS NULL "
   sAll = sAll & "UNION ALL SELECT Sum(Case When cCheckCode Is Null Then 0 Else 1 End), Sum(Case When cCheckCode Is Null Then 1 Else 0 End)" & _
      " FROM FD_UnwDeb WHERE cBookCode IS NULL "
   sAll = sAll & "UNION ALL SELECT Sum(Case When cCheckCode Is Null Then 0 Else 1 End), Sum(Case When cCheckCode Is Null Then 1 Else 0 End)" & _
      " FROM FD_UnwRet WHERE cBookCode IS NULL "
   sAll = sAll & "UNION ALL SELECT Sum(Case When cCheckCode Is Null Then 0 Else 1 End), Sum(Case When cCheckCode Is Null Then 1 Else 0 End)" & _
      " FROM FD_UnwAcrRcp WHERE cBookCode IS NULL "
   sAll = sAll & "UNION ALL SELECT Sum(Case When cCheckCode Is Null Then 0 Else 1 End), Sum(Case When cCheckCode Is Null Then 1 Else 0 End)" & _
      " FROM FD_Sav WHERE cBookCode IS NULL "
   sAll = sAll & "UNION ALL SELECT Sum(Case When cCheckCode Is Null Then 0 Else 1 End), Sum(Case When cCheckCode Is Null Then 1 Else 0 End)" & _
      " FROM FD_Fetch WHERE cBookCode IS NULL "
   sAll = sAll & "UNION ALL SELECT Sum(Case When cCheckCode Is Null Then 0 Else 1 End), Sum(Case When cCheckCode Is Null Then 1 Else 0 End)" & _
      " FROM FD_SettAcc WHERE cBookCode IS NULL "
   sAll = sAll & "UNION ALL SELECT Sum(Case When cCheckCode Is Null Then 0 Else 1 End), Sum(Case When cCheckCode Is Null Then 1 Else 0 End)" & _
      " FROM FD_CadAcr WHERE cBookCode IS NULL "
   Set rsTemp = dbsZJ.OpenRecordset(sAll, dbOpenDynaset)
   While Not rsTemp.EOF
      lngChecked = lngChecked + IIf(IsNull(rsTemp!iChecked), 0, rsTemp!iChecked)
      lngUncheck = lngUncheck + IIf(IsNull(rsTemp!iUnChecked), 0, rsTemp!iUnChecked)
      rsTemp.MoveNext
   Wend
   edtChecked = lngChecked
   edtUnChecked = lngUncheck
End Sub

Private Sub Form_Unload(Cancel As Integer)
   Set rsSumWb = Nothing
End Sub