frmmuchvillage.frm

适合乡镇供电所使用电费处理系统v3 软件

       Input #1, TempStr
       With tempDBF
            .AddNew
            .Fields!Txstr = TempStr
            .Update
       End With
       ik = ik + 1
       Progress.Value = ik
   Loop
   Close #1
   Set tempDBF0 = NdMd.OpenRecordset("Temp0")
   Progress.Max = tempDBF.RecordCount - 1
   tempDBF.MoveFirst
   For ik = 0 To tempDBF.RecordCount - 1
       With tempDBF0
           .AddNew
           .Fields!tempstru = Mid(tempDBF.Fields!Txstr, 1, 32)
           .Update
           .AddNew
           .Fields!tempstru = Mid(tempDBF.Fields!Txstr, 33, 32)
           .Update
       End With
       tempDBF.MoveNext
       Progress.Value = ik
   Next
   NdMd.Execute "DELETE * From Temp0 where tempstru='FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF'"
   Set tempDBF0 = NdMd.OpenRecordset("SELECT * FROM Temp0 WHERE Mid(tempstru,5,1)<>'F'")
   tempDBF0.MoveLast
   Dim PublicCound As Integer
   PublicCound = tempDBF0.RecordCount - 1
   Set MdbR = NdMd.OpenRecordset("SendMdb")
   tempDBF0.MoveFirst
   Progress.Value = 0
   Progress.Min = 0
   Progress.Max = tempDBF0.RecordCount - 1
   For I = 0 To tempDBF0.RecordCount - 1
       If Mid(tempDBF0.Fields!tempstru, 1, 4) = Mid(GzNian, 3, 2) & GzYue Then
          With MdbR
               .AddNew
               .Fields!区号 = Mid(tempDBF0.Fields!tempstru, 5, 6)
               .Fields!户数 = Mid(tempDBF0.Fields!tempstru, 15, 4)
               .Fields!抄录户数 = Mid(tempDBF0.Fields!tempstru, 19, 4)
               .Fields!下载户数 = Mid(tempDBF0.Fields!tempstru, 23, 4)
               .Update
           End With
       End If
       Progress.Value = I
       tempDBF0.MoveNext
   Next
   Set tempDBF = NdMd.OpenRecordset("Temp0")
   
   Progress.Value = 0
   Progress.Min = 0
   Progress.Max = tempDBF.RecordCount

   For I = 1 To tempDBF.RecordCount
       tempDBF.Edit
       tempDBF.Fields!ID = I
       tempDBF.Update
       tempDBF.MoveNext
       Progress.Value = I
   Next
   
   
   NdMd.Execute "DELETE * From Temp0 WHERE id=1"      '删除第一行无效
   NdMd.Execute "DELETE * From Temp0 WHERE id=2"      '删除第二行无效
   Set tempDBF0 = NdMd.OpenRecordset("SendMdb")
   Dim RqQh As String
   For I = 1 To tempDBF0.RecordCount
       RqQh = tempDBF0.Fields!区号
       NdMd.Execute "DELETE * From Temp0 WHERE left(temp0.tempstru,10)='" & Right(GzNian, 2) & GzYue & RqQh & "'"     '删除所有不是用户信息的纪录
       tempDBF0.MoveNext
   Next
'   Set tempDBF = NdMd.OpenRecordset("Temp0")
'   Set tempDBF0 = NdMd.OpenRecordset("SendMdb")
'编号
   Progress.Value = 0
   Progress.Min = 0
   Progress.Max = tempDBF.RecordCount
   tempDBF.MoveFirst
   For I = 1 To tempDBF.RecordCount
       tempDBF.Edit
       tempDBF.Fields!ID = I
       tempDBF.Update
       tempDBF.MoveNext
       Progress.Value = I
   Next
    
   Dim jgf As Integer, JH As Integer
   Dim qdm As String, SqlLoca As String
   jgf = 0
   If tempDBF0.RecordCount <> 0 Then
      tempDBF0.MoveFirst
   End If
   Progress1.Value = 0
   Progress1.Min = 0
   Progress1.Max = tempDBF0.RecordCount
   For I = 0 To tempDBF0.RecordCount - 1
       qdm = tempDBF0.Fields!区号
       jgf = Val(tempDBF0.Fields!户数)
       '创建记录
       SqlLoca = "SELECT temp0.* INTO tempmdb From temp0 WHERE temp0.id>=1 and temp0.id<= " & jgf & ""
       NdMd.Execute SqlLoca
       '删除记录
       SqlLoca = "DELETE * FROM temp0 WHERE id>=1 and id<=" & jgf & ""
       NdMd.Execute SqlLoca
       '重新编号
       Set tempDBF = NdMd.OpenRecordset("Temp0")
       If tempDBF.RecordCount <> 0 Then
          tempDBF.MoveFirst
          Progress.Value = 0
          Progress.Min = 0
          Progress.Max = tempDBF.RecordCount
          For JH = 1 To tempDBF.RecordCount
              tempDBF.Edit
              tempDBF.Fields!ID = JH
              tempDBF.Update
              tempDBF.MoveNext
              Progress.Value = JH
          Next
       End If
       '开始入库
       Set tempDBF = NdMd.OpenRecordset("TempMdb")
       If tempDBF.RecordCount <> 0 Then
       tempDBF.MoveLast
       tempDBF.MoveFirst
       Progress.Min = 0
       Progress.Value = 0
       Progress.Max = tempDBF.RecordCount - 1
       For ik = 0 To Progress.Max
               'If ik = 90 Then Stop
               Set MdbR = NdMd.OpenRecordset("SELECT 用户电费.镇村代码,用户电费.辅助号,用户电费.状态,用户电费.用户类型,用户电费.多表序号,用户电费.抄表码,用户电费.组合编码,用户电费.[" & AA & "] AS 本期示数,用户电费.[" & VV & "] AS 抄表时间,用户电费.相数标识 From 用户电费 WHERE 用户电费.抄表码='" & Mid(tempDBF.Fields!tempstru, 7, 6) & "' and 用户电费.镇村代码='" & qdm & " 'order by 用户电费.抄表码 asc")
               If MdbR.RecordCount <> 0 Then
                  If Mid(tempDBF.Fields!tempstru, 19, 1) <> "F" Then
                     With MdbR
                       .Edit
                       .Fields!本期示数 = Mid(tempDBF.Fields!tempstru, 19, 6)
                       .Fields!抄表时间 = Mid(tempDBF.Fields!tempstru, 31, 2) & "日" & Mid(tempDBF.Fields!tempstru, 29, 2) & "时" & Mid(tempDBF.Fields!tempstru, 27, 2) & "分" & Mid(tempDBF.Fields!tempstru, 25, 2) & "秒"
                       .Update
                    End With
                  End If
               End If
               tempDBF.MoveNext
               Progress.Value = ik
               DoEvents
       Next
       tempDBF.Close
       NdMd.Execute "DROP TABLE tempmdb"
       Progress1.Value = I
       tempDBF0.MoveNext
      Else
       tempDBF.Close
       NdMd.Execute "DROP TABLE tempmdb"
      End If
   Next
   Progress.Value = 0
   Progress1.Value = 0
   Command7.Enabled = True
   MsgBox "数据入库工作处理完毕，请计算电费！", vbInformation
   Screen.MousePointer = 1
   Exit Sub
   
CommClicE:
   If Err.Number = 3010 Then
      NdMd.Execute "DROP TABLE tempmdb"
      MsgBox Err.Description & "本次失败!", vbCritical
      Command7.Enabled = True
      Progress1.Value = 0
      Progress.Value = 0
      Screen.MousePointer = 0
      Exit Sub
   End If
End Sub

Private Sub Form_Load()
    Dim intRecCount, intCounter As Integer
    On Error Resume Next
    Me.Move (Screen.Width - Me.Width) / 2, (Screen.Height - Me.Height) / 2 ' 2
    If Trim(Str(QueryValue(HKEY_CURRENT_USER, "Software\VB and VBA Program Settings\Nx3DataTransmit\其他", "ExitData"))) = "1" Then
       Check3.Value = 1
    Else
       Check3.Value = 0
    End If
    If Trim(Str(QueryValue(HKEY_CURRENT_USER, "Software\VB and VBA Program Settings\Eps\SysSetup", "XsTag"))) = "1" Then
       Check2.Value = 1
       RegVal = True
    Else
       Check2.Value = 0
       RegVal = False
    End If
    
    If Trim(Str(QueryValue(HKEY_CURRENT_USER, "Software\VB and VBA Program Settings\Eps\SysSetup", "NoTag"))) = "1" Then
       Check4.Value = 1
       Check2.Value = 0
       NoTag = True
    Else
       Check4.Value = 0
       NoTag = False
    End If
    
    If FileExists(App.Path & "\SendTx.txt") Then
      Kill App.Path & "\SendTx.txt"
    End If
    If FileExists(App.Path & "\ReveTx.txt") Then
      Kill App.Path & "\ReveTx.txt"
    End If
    Command2.Enabled = False
    Image2.Visible = False
    'Command1.Enabled = False
    OpenMdb
    Set MdbR = NdMd.OpenRecordset("乡镇档案")
    MdbR.MoveLast
    intCounter = MdbR.RecordCount
    MdbR.MoveFirst
    For intRecCount = 0 To intCounter - 1
        List1.AddItem& MdbR.Fields("镇代码") & " " & MdbR.Fields("简称") & ""
        MdbR.MoveNext
    Next intRecCount
    List1.ListIndex = 0
    Command6.Enabled = False
End Sub


Private Sub Form_Unload(Cancel As Integer)
    On Error Resume Next
    MdbR.Close
    NdMd.Close
End Sub

Private Sub List1_Click()
    Dim intRecCount, intCounter As Integer
    Dim Nd As Recordset
    On Error Resume Next
    Set MdbR = NdMd.OpenRecordset("SELECT 村代码,简称 FROM 村档案 WHERE 村档案.镇代码 ='" & Mid(Trim(List1.Text), 1, 3) & "'")
    MdbR.MoveLast
    intCounter = MdbR.RecordCount
    MdbR.MoveFirst
    List2.Clear
    For intRecCount = 0 To intCounter - 1
        Set Nd = NdMd.OpenRecordset("SELECT count(*)as zsh FROM 用户电费 WHERE 用户电费.镇村代码= '" & Mid(Trim(List1.Text), 1, 3) & Trim(MdbR.Fields("村代码")) & "'")
        List2.AddItem& MdbR.Fields("村代码") & " " & MdbR.Fields("简称") & " " & Nd.Fields!zsh & "只表"
        MdbR.MoveNext
    Next intRecCount
    List2.ListIndex = 0
End Sub

Private Sub List2_Click()
   Dim j As Integer, k As Integer, l As Integer
   For j = 0 To List2.ListCount - 1
      If List2.Selected(j) Then
         k = k + 1
         If k > 0 Then
            Command2.Enabled = True
         Else
            Command2.Enabled = False
         End If
      Else
         If k > 0 Then
            Command2.Enabled = True
         Else
            Command2.Enabled = False
         End If
      End If
   Next
   List2.ListIndex = 0
End Sub