rsTable.MoveNext
   Loop

End Sub
'*******************************************************************
'*函數說明:對定期存款單進行利息計算                                  *
'*參    數:                                                        *
'*返回值  :                                                        *
'*******************************************************************
Private Sub EstimateCadSav()
   Dim sqlTable As String
   Dim sqlCad As String
   Dim rsTable As New UfRecordset
   Dim rsCad As New UfRecordset
   Dim dYmd As Date
   
   sqlTable = "SELECT * FROM FD_Sav WHERE NOT bsettle AND isc=0"
   Set rsTable = dbsZJ.OpenRecordset(sqlTable, dbOpenDynaset)
   If Not rsTable.EOF Then
      rsTable.MoveLast
      Me.ProgressBar1.Max = rsTable.RecordCount
      rsTable.MoveFirst
   End If
   While Not rsTable.EOF
      ChangeStatus Right(rsTable!cSavID, 8), 1
      dYmd = GetDqDate(rsTable!iMonth, rsTable!dbill_date)
      If dYmd - 1 <= dDate Then
         sqlCad = "SELECT * FROM FD_CadAcr WHERE cDanID='" & rsTable!cSavID & _
               "' AND dTo<='" & FormatDate(dYmd) & "'"
         Set rsCad = dbsZJ.OpenRecordset(sqlCad, dbOpenDynaset)
         If rsCad.EOF Then
            ' 計息
            dq_lx rsTable!cAccID, dYmd, True
         End If
      End If
      rsTable.MoveNext
   Wend
   
End Sub

'cuidong YT.A 2001.10.21
'函數說明:對 定期存款單 預提數據 進行利息計算
Private Sub EstimateYtCadSav()
   Dim sqlAccDef  As String
   Dim sqlAccSum  As String
   Dim sqlCadSets As String
   Dim RsAccDef   As New UfRecordset
   Dim rsAccSum   As New UfRecordset
   Dim RsCadSets  As New UfRecordset
   Dim Rs As UfRecordset
   Dim dTemp      As Date
   Dim dOpenDate  As Date
   
   
   Dim sqlTable As String
   Dim sqlCad As String
   Dim rsTable As New UfRecordset
   Dim rsCad As New UfRecordset
   Dim dYmd As Date
   
   Dim dStartDate As Date
   Dim sEndDate As String
   
   '包括已銷戶的
   sqlTable = "SELECT FD_AccDef.cAccID, FD_AccDef.iYt, FD_AccDef.cYtID, FD_Sav.cSavID, FD_Sav.iMonth, FD_Sav.dBill_Date, FD_Sav.bSettle FROM FD_Sav, FD_AccDef WHERE FD_Sav.cAccID = FD_AccDef.cAccID And FD_Sav.isc=0 And (Not FD_AccDef.iYt = 0) And (Not FD_AccDef.cYtID Is Null) And (Not cBookCode Is Null) "
   Set rsTable = dbsZJ.OpenRecordset(sqlTable, dbOpenDynaset)
   If Not rsTable.EOF Then
      rsTable.MoveLast
      Me.ProgressBar1.Max = rsTable.RecordCount
      rsTable.MoveFirst
   End If
   
   While Not rsTable.EOF
      If (Not IIf(IsNull(rsTable!iYt), 0, rsTable!iYt) = 0) And (Not IsNull(rsTable!cYtID)) Then
         ChangeStatus rsTable!cAccID, 1
         dStartDate = rsTable!dbill_date '首次預提計息的起始日期
         sEndDate = vbNullString
         If Not IsNull(rsTable!bSettle) Then
            If Not rsTable!bSettle = 0 Then
               '已經結清
               Set Rs = dbsZJ.OpenRecordset("Select Max(dBill_Date) As dBill_Date From FD_Fetch Where cAccID = '" & rsTable!cAccID & "'")
               If Not IsNull(Rs!dbill_date) Then
                  sEndDate = Format(Rs!dbill_date, "YYYY-MM-DD")
               End If
               Rs.oClose
                
            End If
         End If
         '---- 取出結息日信息
         sqlCadSets = "SELECT dClosDate FROM FD_CadSets WHERE cCadID='" & rsTable!cYtID & "' ORDER BY dClosDate"
         Set RsCadSets = dbsZJ.OpenRecordset(sqlCadSets, dbOpenSnapshot)
         Do While Not RsCadSets.EOF
            dTemp = RsCadSets!dClosDate
            If dDate < dTemp Then Exit Do
            If Not sEndDate = vbNullString Then
               '預提日（結息日）當天或之前若 有實際利息單發生，則不生成預提利息單
               If CDate(sEndDate) <= dTemp Then Exit Do
            End If
'            If dTemp > RetEndDay(rsTable!dbill_date, rsTable!iMonth) - 1 Then
'               Exit Do '最后一個預提日 - 定期取款日 之間的利息不計算，否則請刪去此行。
'               dTemp = RetEndDay(rsTable!dbill_date, rsTable!iMonth) - 1
'            End If
            
            If dTemp > rsTable!dbill_date Then
               sqlAccSum = "SELECT * FROM FD_YtCadAcr WHERE cGAccID='" & rsTable!cAccID & _
                     "' AND dBill_date='" & FormatDate(dTemp) & "'"
               Set rsAccSum = dbsZJ.OpenRecordset(sqlAccSum, dbOpenDynaset)
               If rsAccSum.EOF Then
                  '計算預提日（結息日）利息
                  DQ_YtLx rsTable!cAccID, dStartDate, dTemp, True
               End If
               rsAccSum.oClose
               dStartDate = RsCadSets!dClosDate + 1 '下次預提計息的起始日期
            End If
            
            RsCadSets.MoveNext
         Loop
      End If
      rsTable.MoveNext
   Wend
'
'   While Not rsTable.EOF
'      ChangeStatus Right(rsTable!cSavID, 8), 1
'      dYmd = GetDqDate(rsTable!iMonth, rsTable!dbill_date)
'      If dYmd - 1 <= dDate Then
'         sqlCad = "SELECT * FROM FD_CadAcr WHERE cDanID='" & rsTable!cSavID & _
'               "' AND dTo<='" & FormatDate(dYmd) & "'"
'         Set rsCad = dbsZJ.OpenRecordset(sqlCad, dbOpenDynaset)
'         If rsCad.EOF Then
'            ' 計息
'            dq_lx rsTable!cAccID, dYmd, True
'         End If
'      End If
'      rsTable.MoveNext
'   Wend
      
End Sub

Private Function GetDqDate(lngMonth As Integer, dPre As Date) As Date
   Dim iYear   As Long
   Dim iMonth  As Long
   Dim iDay    As Long
   
   iMonth = (Month(dPre) + lngMonth) Mod 12
   If iMonth = 0 Then iMonth = 12
   iYear = Year(dPre) + (Month(dPre) + lngMonth - 1) \ 12
   iDay = Day(dPre)
   
   On Error GoTo lblErr
   GetDqDate = CDate(iYear & "-" & iMonth & "-" & iDay)
   Exit Function

lblErr:
   iDay = iDay - 1
   Resume

End Function

Private Sub RezeroStatus(strLabel0 As String, strLabel1 As String, Optional lngMax As Variant)
   With Me
      .ProgressBar1.Value = 0
      If Not IsMissing(lngMax) Then .ProgressBar1.Max = lngMax
      .Label1(4) = strLabel0
      .Label1(1) = strLabel1
      .Label1(0).Left = .Label1(1).Left + .Label1(1).Width + 100
      .Label1(0) = ""
      .Refresh
   End With
End Sub

Private Sub ChangeStatus(strLabel2 As String, lngUnit As Long, Optional strLabel1 As Variant)
   With Me
      On Error Resume Next
      .ProgressBar1.Value = .ProgressBar1.Value + lngUnit
      If Not IsMissing(strLabel1) Then .Label1(1) = strLabel1
      .Label1(0) = strLabel2
      .Refresh
   End With
End Sub

'資金賬戶的定額處理
Private Sub ZjDeTreat()
   Dim rsAccSum   As New UfRecordset
   Dim RsAccDef   As New UfRecordset
   Dim sqlAccSum  As String
   Dim sqlAccDef  As String
   Dim vDe        As Variant
   Dim cDe        As Currency
   Dim cMh_c      As Currency
   
   On Error Resume Next
   sqlAccDef = "SELECT cAccID FROM FD_AccDef WHERE iDataSrc=0 AND itype=1"
   Set RsAccDef = dbsZJ.OpenRecordset(sqlAccDef, dbOpenSnapshot)
   If Not RsAccDef.EOF Then
      RsAccDef.MoveLast
      RezeroStatus "正在進行定額處理...", "資金賬戶：", RsAccDef.RecordCount
      RsAccDef.MoveFirst
   End If
   While Not RsAccDef.EOF
      ChangeStatus RsAccDef!cAccID, 1, "資金賬戶："
      sqlAccSum = "SELECT * FROM FD_AccSum WHERE cAccID='" & RsAccDef!cAccID & _
                  "' ORDER BY dbill_date"
      Set rsAccSum = dbsZJ.OpenRecordset(sqlAccSum, dbOpenDynaset)
      DeResult RsAccDef!cAccID
      cMh_c = 0
      With rsAccSum
         While Not .EOF
            vDe = GetDe(!dbill_date)
            If Not IsEmpty(vDe) Then
               cDe = !Mb - CCur(vDe)
               .Edit
               !Mcde = IIf(cDe > 0, cDe, 0)
               !Mcdeh = cMh_c + !Mcde - !Mcdeh_Cad
               cMh_c = IIf(IsNull(!Mcdeh), 0, !Mcdeh)
               .Update
            Else
               .Edit
               !Mcdeh = cMh_c - !Mcdeh_Cad
               .Update
            End If
            .MoveNext
         Wend
      End With
      RsAccDef.MoveNext
   Wend
   CloseRS RsAccDef
End Sub

'*******************************************************************
'*函數說明:對總賬表進行初始化                                       *
'*參    數:                                                        *
'*返回值  :                                                        *
'*******************************************************************
Private Sub InitFD_Accsum()
   Dim rsAccSum As New UfRecordset
   Dim RsAccDef As New UfRecordset
   Dim sqlAccSum As String
   Dim sqlAccDef As String
   Dim strQryChg As String
   
   On Error GoTo lblErr
   dbsZJ.BeginTrans
   ' 資金賬戶
   sqlAccDef = "SELECT cAccID, mb, mh, dOpenDate FROM FD_AccDef WHERE iDataSrc=0 AND itype=1"
   Set RsAccDef = dbsZJ.OpenRecordset(sqlAccDef, dbOpenSnapshot)
   If Not RsAccDef.EOF Then
      RsAccDef.MoveLast
      RezeroStatus "正在進行初始化...", "資金賬戶：", RsAccDef.RecordCount
      RsAccDef.MoveFirst
   End If
   While Not RsAccDef.EOF
      ChangeStatus RsAccDef!cAccID, 1, "資金賬戶："
      sqlAccSum = "SELECT * FROM FD_AccSum WHERE cAccID='" & RsAccDef!cAccID & _
                  "' ORDER BY dbill_date"
      Set rsAccSum = dbsZJ.OpenRecordset(sqlAccSum, dbOpenDynaset)
      With rsAccSum
         If .EOF Then
            .AddNew
            !cAccID = RsAccDef!cAccID
            !dbill_date = IIf(RsAccDef!dOpenDate < ZjAccInfo.zjStartdate, ZjAccInfo.zjStartdate, RsAccDef!dOpenDate) - 1 '----zcl change
            !Mb = RsAccDef!Mb
            !Mh = RsAccDef!Mh
            .Update
         Else
            '期初改變
            If RsAccDef!Mb <> !Mb Or RsAccDef!Mh <> !Mh Then
               strQryChg = "UPDATE FD_AccSum SET mb = mb + " & (RsAccDef!Mb - !Mb) & _
                  ", mh = mh + " & (RsAccDef!Mh - !Mh) & " + " & _
                  Format((RsAccDef!Mb - !Mb), "#0.00") & " * (DateDiff(Day, '" & FormatDate(RsAccDef!dOpenDate) & "', dbill_date) + 1)" & _
                  "WHERE cAccID = '" & RsAccDef!cAccID & "'"
               dbsZJ.Execute strQryChg
            End If
         End If
      End With
      
      ' 將 FD_AccSum(總賬表) 中每一賬戶追補到今日
      TraceToNow RsAccDef!cAccID
      RsAccDef.MoveNext
   Wend
   dbsZJ.CommitTrans
   On Error GoTo 0
   
   ' 外部賬戶
   sqlAccDef = "SELECT cAccID, dOpenDate FROM FD_AccDef WHERE iDataSrc=1"
   Set RsAccDef = dbsZJ.OpenRecordset(sqlAccDef, dbOpenSnapshot)
   If Not RsAccDef.EOF Then
      RsAccDef.MoveLast
      RezeroStatus "正在進行初始化...", "外部賬戶：", RsAccDef.RecordCount
      RsAccDef.MoveFirst
      
      Set rsSumWb = dbsZJ.OpenRecordset("FD_AccSum", dbOpenDynaset)
   End If
   
   While Not RsAccDef.EOF
      ChangeStatus RsAccDef!cAccID, 1, "外部賬戶："
      
      Dim dBillDate  As Date
      Dim rsX        As New UfRecordset
      Dim sqlX       As String
      
      sqlX = "SELECT Max(dbill_date) AS MaxDate FROM FD_AccSum WHERE cAccID = '" & RsAccDef!cAccID & "'"
      Set rsX = dbsZJ.OpenRecordset(sqlX, dbOpenSnapshot)
      If IsNull(rsX!MaxDate) Then
         dBillDate = IIf(RsAccDef!dOpenDate < ZjAccInfo.zjStartdate, ZjAccInfo.zjStartdate, RsAccDef!dOpenDate) - 1 '----zcl change
      Else
         dBillDate = rsX!MaxDate + 1
      End If
      
      '1
      TraceWb RsAccDef!cAccID, dBillDate
      '2
      DoWb RsAccDef!cAccID, IIf(RsAccDef!dOpenDate < ZjAccInfo.zjStartdate, ZjAccInfo.zjStartdate, RsAccDef!dOpenDate), dDate '----zcl change
      '3
      SucWb RsAccDef!cAccID
      
      RsAccDef.MoveNext
   Wend
   Exit Sub
   
lblErr: