📄 frmmuchvillage.frm
字号:
.Fields!下载户数 = Right("0000" & Trim(Str(l + 1)), 4)
tempLin = Val(Right(List2.List(j), 5))
Else
.Fields!下载户数 = Right("0000" & Trim(Str(l + I)), 4)
End If
.Update
End With
I = I + 1
End If
Next
'下载台区村数，不能超过１０
Cun_Sum = Format(I, "00")
If l > 2000 Then
MsgBox "所选数据" & l & "超出,请减少所选择的单位！", vbCritical, "提示"
' Command1.Enabled = True
Screen.MousePointer = 1
Exit Sub
End If
If l = 0 Then
MsgBox "所选单位无数据,请重新选择要下载的单位！", vbCritical, "提示"
Screen.MousePointer = 1
'Command1.Enabled = True
Exit Sub
End If
Progress.Visible = True
Progress.Min = 0
Progress.Value = 0
'整理密码
For I = 0 To List2.ListCount - 1
If List2.Selected(I) Then
Set MdbR = NdMd.OpenRecordset("SELECT * From 村档案 WHERE 村档案.镇村代码='" & Trim(Mid(List1.Text, 1, 3)) & Trim(Mid(List2.List(I), 1, 3)) & "'")
Set tempDBF = NdMd.OpenRecordset("SELECT * From sendmdb WHERE sendmdb.区号='" & Trim(Mid(List1.Text, 1, 3)) & Trim(Mid(List2.List(I), 1, 3)) & "'")
With tempDBF
.Edit
.Fields!密码 = IIf(Not IsNull(MdbR.Fields!抄表密码), MdbR.Fields!抄表密码, "FFFF") 'IIf(Len(MdbR.Fields!抄表密码) = 0, "FFFF", MdbR.Fields!抄表密码)
.Update
End With
End If
Next
Set tempDBF = NdMd.OpenRecordset("sendmdb")
tempDBF.MoveLast
tempDBF.MoveFirst
For I = 1 To tempDBF.RecordCount
Set tempDBF0 = NdMd.OpenRecordset("temp0")
' If tempDBF.Fields!区号 = "001405" Then Stop
If I > 1 Then '1
If I = tempDBF.RecordCount Then '2
With tempDBF0
.AddNew
.Fields!tempstru = Mid(GzNian, 3, 2) & GzYue & tempDBF.Fields!区号 & tempDBF.Fields!密码 & tempDBF.Fields!户数 & "00000000" & String(6, "F")
.Update
End With
Else '2
With tempDBF0
.AddNew
.Fields!tempstru = Mid(GzNian, 3, 2) & GzYue & tempDBF.Fields!区号 & tempDBF.Fields!密码 & tempDBF.Fields!户数 & "0000" & tempDBF.Fields!下载户数 & String(6, "F")
.Update
End With
End If '2
Else '1
With tempDBF0
.AddNew
.Fields!tempstru = Mid(GzNian, 3, 2) & GzYue & tempDBF.Fields!区号 & tempDBF.Fields!密码 & tempDBF.Fields!户数 & String(8, "0") & Mid(Time$, 7, 2) & Mid(Time$, 4, 2) & Mid(Time$, 1, 2)
.Update
End With
With tempDBF0
.AddNew
.Fields!tempstru = Right("00" & Mid(Date, 9, 2), 2) & Right("00" & Trim(Str(tempDBF.RecordCount)), 2) + tempDBF.Fields!下载户数 & String(24, "F")
.Update
End With
End If '1
'Dim PPP As Integer '建立用户数据
' Dim MeterID As String
Set MdbR = NdMd.OpenRecordset("SELECT 用户电费.用户编码,用户电费.镇村代码,用户电费.状态,用户电费.抄表码,用户电费.组合编码,用户电费.多表序号,用户电费.用户类型,用户电费.辅助号,用户电费.[" & AAA & "] AS 上期示数,用户电费.往期平均,用户电费.相数标识 From 用户电费 WHERE 用户电费.镇村代码='" & tempDBF.Fields!区号 & "' order by 用户电费.组合编码, 用户电费.多表序号")
If MdbR.RecordCount <> 0 Then
MdbR.MoveLast
MdbR.MoveFirst
Progress.Max = MdbR.RecordCount
Progress.Min = 0
Progress.Value = 0
For PPP = 1 To MdbR.RecordCount
' If PPP = 20 Then Stop
Select Case MdbR.Fields!状态
Case "停用" 'FD
With tempDBF0
.AddNew
If NoTag = False Then
If RegVal = True Then
.Fields!tempstru = Right(MdbR.Fields!组合编码, 4) & "F" & IIf(IsNull(MdbR.Fields!相数标识) = True Or Len(MdbR.Fields!相数标识) = 0, MdbR.Fields!多表序号, MdbR.Fields!相数标识) & IIf(IsNull(MdbR.Fields!抄表码) = False, MdbR.Fields!抄表码, "000001") & IIf(Len(MdbR.Fields!上期示数) > 0, Format(MdbR.Fields!上期示数, "000000"), "000000") & "FD" & IIf(IsNull(MdbR.Fields!往期平均) = False, Format(MdbR.Fields!往期平均, "0000"), "0000") & String(8, "F")
Else
.Fields!tempstru = Right(MdbR.Fields!组合编码, 4) & "F" & MdbR.Fields!多表序号 & IIf(IsNull(MdbR.Fields!抄表码) = False, MdbR.Fields!抄表码, "000001") & IIf(Len(MdbR.Fields!上期示数) > 0, Format(MdbR.Fields!上期示数, "000000"), "000000") & "FD" & IIf(IsNull(MdbR.Fields!往期平均) = False, Format(MdbR.Fields!往期平均, "0000"), "0000") & String(8, "F")
End If
Else
.Fields!tempstru = Right(MdbR.Fields!组合编码, 4) & "A" & MdbR.Fields!多表序号 & IIf(IsNull(MdbR.Fields!抄表码) = False, MdbR.Fields!抄表码, "000001") & IIf(Len(MdbR.Fields!上期示数) > 0, Format(MdbR.Fields!上期示数, "000000"), "000000") & "FD" & IIf(IsNull(MdbR.Fields!往期平均) = False, Format(MdbR.Fields!往期平均, "0000"), "0000") & String(8, "F")
End If
.Update
End With
Case "欠费" 'FE
With tempDBF0
.AddNew
If NoTag = False Then
If RegVal = True Then
.Fields!tempstru = Right(MdbR.Fields!组合编码, 4) & "F" & IIf(IsNull(MdbR.Fields!相数标识) = True Or Len(MdbR.Fields!相数标识) = 0, MdbR.Fields!多表序号, MdbR.Fields!相数标识) & IIf(IsNull(MdbR.Fields!抄表码) = False, MdbR.Fields!抄表码, "000001") & IIf(Len(MdbR.Fields!上期示数) > 0, Format(MdbR.Fields!上期示数, "000000"), "000000") & "FE" & IIf(IsNull(MdbR.Fields!往期平均) = False, Format(MdbR.Fields!往期平均, "0000"), "0000") & String(8, "F")
Else
.Fields!tempstru = Right(MdbR.Fields!组合编码, 4) & "F" & MdbR.Fields!多表序号 & IIf(IsNull(MdbR.Fields!抄表码) = False, MdbR.Fields!抄表码, "000001") & IIf(Len(MdbR.Fields!上期示数) > 0, Format(MdbR.Fields!上期示数, "000000"), "000000") & "FE" & IIf(IsNull(MdbR.Fields!往期平均) = False, Format(MdbR.Fields!往期平均, "0000"), "0000") & String(8, "F")
End If
Else
.Fields!tempstru = Right(MdbR.Fields!组合编码, 4) & "A" & MdbR.Fields!多表序号 & IIf(IsNull(MdbR.Fields!抄表码) = False, MdbR.Fields!抄表码, "000001") & IIf(Len(MdbR.Fields!上期示数) > 0, Format(MdbR.Fields!上期示数, "000000"), "000000") & "FE" & IIf(IsNull(MdbR.Fields!往期平均) = False, Format(MdbR.Fields!往期平均, "0000"), "0000") & String(8, "F")
End If
.Update
End With
Case Else 'FF
'If tempDBF.Fields!区号 = "001405" And PPP = 39 Then Stop
With tempDBF0
.AddNew
If NoTag = False Then
If RegVal = True Then
.Fields!tempstru = Right(MdbR.Fields!组合编码, 4) & "F" & IIf(IsNull(MdbR.Fields!相数标识) = True Or Len(MdbR.Fields!相数标识) = 0, MdbR.Fields!多表序号, MdbR.Fields!相数标识) & IIf(IsNull(MdbR.Fields!抄表码) = False, MdbR.Fields!抄表码, "000001") & IIf(Len(MdbR.Fields!上期示数) > 0, Format(MdbR.Fields!上期示数, "000000"), "000000") & "FF" & IIf(IsNull(MdbR.Fields!往期平均) = False, Format(MdbR.Fields!往期平均, "0000"), "0000") & String(8, "F")
Else
.Fields!tempstru = Right(MdbR.Fields!组合编码, 4) & "F" & MdbR.Fields!多表序号 & IIf(IsNull(MdbR.Fields!抄表码) = False, MdbR.Fields!抄表码, "000001") & IIf(Len(MdbR.Fields!上期示数) > 0, Format(MdbR.Fields!上期示数, "000000"), "000000") & "FF" & IIf(IsNull(MdbR.Fields!往期平均) = False, Format(MdbR.Fields!往期平均, "0000"), "0000") & String(8, "F")
End If
Else
.Fields!tempstru = Right(MdbR.Fields!组合编码, 4) & "A" & MdbR.Fields!多表序号 & IIf(IsNull(MdbR.Fields!抄表码) = False, MdbR.Fields!抄表码, "000001") & IIf(Len(MdbR.Fields!上期示数) > 0, Format(MdbR.Fields!上期示数, "000000"), "000000") & "FF" & IIf(IsNull(MdbR.Fields!往期平均) = False, Format(MdbR.Fields!往期平均, "0000"), "0000") & String(8, "F")
End If
.Update
End With
End Select
MdbR.MoveNext
Progress.Value = PPP
Next
End If
tempDBF.MoveNext
Next
Set tempDBF = NdMd.OpenRecordset("TempTxt")
tempDBF0.MoveLast
tempDBF0.MoveFirst
l = 1
Dim jnv As String
Progress.Max = tempDBF0.RecordCount - 1
Progress.Min = 0
Progress.Value = 0
For I = 0 To tempDBF0.RecordCount - 1
'If i = 1868 Then Stop
If l > 1 Then
With tempDBF
.AddNew
.Fields!Txstr = jnv + tempDBF0.Fields!tempstru
.Update
End With
l = 0
Else
jnv = tempDBF0.Fields!tempstru
End If
l = l + 1
tempDBF0.MoveNext
If tempDBF0.eof Then
With tempDBF
.AddNew
.Fields!Txstr = jnv & String(32, "F")
.Update
End With
End If
Progress.Value = I
Next
Open App.Path & "\SendTx.txt" For Output As #1
Dim intRecCount, intCounter As Integer
Progress.Visible = True
Progress.Max = tempDBF.RecordCount - 1
Progress.Min = 0
tempDBF.MoveLast
tempDBF.MoveFirst
For intCounter = 0 To Progress.Max
Print #1, tempDBF.Fields!Txstr
tempDBF.MoveNext
Progress.Value = intCounter
DoEvents
Next intCounter
Progress.Value = Progress.Min
Screen.MousePointer = 0
Command2.Enabled = True
Close
Screen.MousePointer = 1
'MsgBox "下载用户数据生成完毕，请单击下载数据按钮开始通讯...", vbInformation
' Command1.Enabled = True
Exit Sub
CreaErr:
MsgBox Err.Description, vbCritical
Exit Sub
End Sub
Private Sub Command2_Click()
Dim retval
If FileExists(App.Path & "\Nx3DataTransmit.EXE") Then
Call CreaTxt
retval = Shell(App.Path & "\Nx3DataTransmit.EXE S", 1)
Else
MsgBox "数据通信失败，原始文件找不到！", vbCritical
Exit Sub
End If
End Sub
Private Sub Command3_Click()
Dim retval
If FileExists(App.Path & "\Nx3DataTransmit.EXE") Then
retval = Shell(App.Path & "\Nx3DataTransmit.EXE R", 1)
' If FileExists(App.Path & "\ReveTx.txt") Then
' If MsgBox("数据上载完毕，是否现在入库？", vbQuestion + vbYesNo, Caption) = vbYes Then
' Call InputUserData
' End If
' End If
Else
MsgBox "数据通信失败，原始文件找不到！", vbCritical
Exit Sub
End If
End Sub
Private Sub Command4_Click()
Dim retval
If FileExists(App.Path & "\Nx3DataTransmit.EXE") Then
retval = Shell(App.Path & "\Nx3DataTransmit.EXE T", 1)
Else
MsgBox "数据通信失败，原始文件找不到！", vbCritical
Exit Sub
End If
End Sub
Private Sub Command5_Click()
Unload Me
End Sub
Private Sub Command6_Click()
If pbUserPermission <> "系统管理员" Then
MsgBox "您的权限不够，请于系统管理员联系!", vbInformation
Exit Sub
End If
FrmCBQpass.Show vbModal
End Sub
Private Sub Command7_Click()
'Sub InputUserData()
Dim TempStr As String
Dim I As Integer, ik As Integer
On Error GoTo CommClicE
Screen.MousePointer = 11
NdMd.Execute "DELETE * From sendMDB "
NdMd.Execute "DELETE * From Temp0 "
NdMd.Execute "DELETE * From TempTxt"
If FileExists(App.Path & "\ReveTx.txt") Then
Open App.Path & "\ReveTx.txt" For Input As #1
Else
MsgBox "数据处理失败，上载数据文件找不到！", vbCritical
Screen.MousePointer = 1
Exit Sub
End If
Command7.Enabled = False
Set tempDBF = NdMd.OpenRecordset("TempTxt")
I = 0
Do Until eof(1)
Input #1, TempStr
I = I + 1
Loop
Close #1
Progress.Max = I
Open App.Path & "\ReveTx.txt" For Input As #1
Do Until eof(1)
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -