?? frmmuchvillage.frm
字號:
.Fields!下載戶數(shù) = Right("0000" & Trim(Str(l + 1)), 4)
tempLin = Val(Right(List2.List(j), 5))
Else
.Fields!下載戶數(shù) = Right("0000" & Trim(Str(l + I)), 4)
End If
.Update
End With
I = I + 1
End If
Next
'下載臺區(qū)村數(shù)，不能超過１０
Cun_Sum = Format(I, "00")
If l > 2000 Then
MsgBox "所選數(shù)據(jù)" & l & "超出,請減少所選擇的單位！", vbCritical, "提示"
' Command1.Enabled = True
Screen.MousePointer = 1
Exit Sub
End If
If l = 0 Then
MsgBox "所選單位無數(shù)據(jù),請重新選擇要下載的單位！", 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 村檔案.鎮(zhèn)村代碼='" & Trim(Mid(List1.Text, 1, 3)) & Trim(Mid(List2.List(I), 1, 3)) & "'")
Set tempDBF = NdMd.OpenRecordset("SELECT * From sendmdb WHERE sendmdb.區(qū)號='" & 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!區(qū)號 = "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!區(qū)號 & tempDBF.Fields!密碼 & tempDBF.Fields!戶數(shù) & "00000000" & String(6, "F")
.Update
End With
Else '2
With tempDBF0
.AddNew
.Fields!tempstru = Mid(GzNian, 3, 2) & GzYue & tempDBF.Fields!區(qū)號 & tempDBF.Fields!密碼 & tempDBF.Fields!戶數(shù) & "0000" & tempDBF.Fields!下載戶數(shù) & String(6, "F")
.Update
End With
End If '2
Else '1
With tempDBF0
.AddNew
.Fields!tempstru = Mid(GzNian, 3, 2) & GzYue & tempDBF.Fields!區(qū)號 & tempDBF.Fields!密碼 & tempDBF.Fields!戶數(shù) & 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!下載戶數(shù) & String(24, "F")
.Update
End With
End If '1
'Dim PPP As Integer '建立用戶數(shù)據(jù)
' Dim MeterID As String
Set MdbR = NdMd.OpenRecordset("SELECT 用戶電費(fèi).用戶編碼,用戶電費(fèi).鎮(zhèn)村代碼,用戶電費(fèi).狀態(tài),用戶電費(fèi).抄表碼,用戶電費(fèi).組合編碼,用戶電費(fèi).多表序號,用戶電費(fèi).用戶類型,用戶電費(fèi).輔助號,用戶電費(fèi).[" & AAA & "] AS 上期示數(shù),用戶電費(fèi).往期平均,用戶電費(fèi).相數(shù)標(biāo)識 From 用戶電費(fèi) WHERE 用戶電費(fèi).鎮(zhèn)村代碼='" & tempDBF.Fields!區(qū)號 & "' order by 用戶電費(fèi).組合編碼, 用戶電費(fèi).多表序號")
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!狀態(tài)
Case "停用" 'FD
With tempDBF0
.AddNew
If NoTag = False Then
If RegVal = True Then
.Fields!tempstru = Right(MdbR.Fields!組合編碼, 4) & "F" & IIf(IsNull(MdbR.Fields!相數(shù)標(biāo)識) = True Or Len(MdbR.Fields!相數(shù)標(biāo)識) = 0, MdbR.Fields!多表序號, MdbR.Fields!相數(shù)標(biāo)識) & IIf(IsNull(MdbR.Fields!抄表碼) = False, MdbR.Fields!抄表碼, "000001") & IIf(Len(MdbR.Fields!上期示數(shù)) > 0, Format(MdbR.Fields!上期示數(shù), "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!上期示數(shù)) > 0, Format(MdbR.Fields!上期示數(shù), "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!上期示數(shù)) > 0, Format(MdbR.Fields!上期示數(shù), "000000"), "000000") & "FD" & IIf(IsNull(MdbR.Fields!往期平均) = False, Format(MdbR.Fields!往期平均, "0000"), "0000") & String(8, "F")
End If
.Update
End With
Case "欠費(fèi)" 'FE
With tempDBF0
.AddNew
If NoTag = False Then
If RegVal = True Then
.Fields!tempstru = Right(MdbR.Fields!組合編碼, 4) & "F" & IIf(IsNull(MdbR.Fields!相數(shù)標(biāo)識) = True Or Len(MdbR.Fields!相數(shù)標(biāo)識) = 0, MdbR.Fields!多表序號, MdbR.Fields!相數(shù)標(biāo)識) & IIf(IsNull(MdbR.Fields!抄表碼) = False, MdbR.Fields!抄表碼, "000001") & IIf(Len(MdbR.Fields!上期示數(shù)) > 0, Format(MdbR.Fields!上期示數(shù), "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!上期示數(shù)) > 0, Format(MdbR.Fields!上期示數(shù), "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!上期示數(shù)) > 0, Format(MdbR.Fields!上期示數(shù), "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!區(qū)號 = "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!相數(shù)標(biāo)識) = True Or Len(MdbR.Fields!相數(shù)標(biāo)識) = 0, MdbR.Fields!多表序號, MdbR.Fields!相數(shù)標(biāo)識) & IIf(IsNull(MdbR.Fields!抄表碼) = False, MdbR.Fields!抄表碼, "000001") & IIf(Len(MdbR.Fields!上期示數(shù)) > 0, Format(MdbR.Fields!上期示數(shù), "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!上期示數(shù)) > 0, Format(MdbR.Fields!上期示數(shù), "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!上期示數(shù)) > 0, Format(MdbR.Fields!上期示數(shù), "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 "下載用戶數(shù)據(jù)生成完畢，請單擊下載數(shù)據(jù)按鈕開始通訊...", 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 "數(shù)據(jù)通信失敗，原始文件找不到！", 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("數(shù)據(jù)上載完畢，是否現(xiàn)在入庫？", vbQuestion + vbYesNo, Caption) = vbYes Then
' Call InputUserData
' End If
' End If
Else
MsgBox "數(shù)據(jù)通信失敗，原始文件找不到！", 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 "數(shù)據(jù)通信失敗，原始文件找不到！", vbCritical
Exit Sub
End If
End Sub
Private Sub Command5_Click()
Unload Me
End Sub
Private Sub Command6_Click()
If pbUserPermission <> "系統(tǒng)管理員" Then
MsgBox "您的權(quán)限不夠，請于系統(tǒng)管理員聯(lián)系!", 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 "數(shù)據(jù)處理失敗，上載數(shù)據(jù)文件找不到！", 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)
?? 快捷鍵說明
復(fù)制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號
Ctrl + =
減小字號
Ctrl + -