📄 inputolddata.frm
字号:
VERSION 5.00
Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0"; "MSCOMCTL.OCX"
Begin VB.Form InputOldData
BorderStyle = 3 'Fixed Dialog
Caption = "导入MND3.8版电费数据"
ClientHeight = 4050
ClientLeft = 45
ClientTop = 330
ClientWidth = 6780
Icon = "InputOldData.frx":0000
LinkTopic = "Form2"
MaxButton = 0 'False
MinButton = 0 'False
ScaleHeight = 4050
ScaleWidth = 6780
ShowInTaskbar = 0 'False
StartUpPosition = 3 '窗口缺省
Begin MSComctlLib.ProgressBar PrBar1
Height = 330
Left = 90
TabIndex = 7
Top = 4065
Width = 6615
_ExtentX = 11668
_ExtentY = 582
_Version = 393216
Appearance = 1
End
Begin VB.Frame Frame2
Caption = "导入选择"
Height = 2415
Left = 15
TabIndex = 1
Top = 1635
Width = 6750
Begin VB.Timer Timer1
Interval = 1000
Left = 5400
Top = 0
End
Begin VB.CommandButton Command2
Caption = "关闭窗口(&E)"
Height = 375
Index = 3
Left = 5295
TabIndex = 9
Top = 1815
Width = 1215
End
Begin VB.CommandButton Command2
Caption = "开始导入(&S)"
Height = 375
Index = 2
Left = 5295
TabIndex = 8
Top = 1320
Width = 1215
End
Begin VB.CommandButton Command2
Caption = "取消全部(&C)"
Height = 375
Index = 1
Left = 5295
TabIndex = 6
Top = 840
Width = 1215
End
Begin VB.CommandButton Command2
Caption = "选择全部(&A)"
Height = 375
Index = 0
Left = 5295
TabIndex = 5
Top = 360
Width = 1215
End
Begin VB.ListBox List1
BeginProperty Font
Name = "宋体"
Size = 10.5
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 1950
ItemData = "InputOldData.frx":030A
Left = 120
List = "InputOldData.frx":030C
MultiSelect = 1 'Simple
TabIndex = 4
Top = 240
Width = 4815
End
End
Begin VB.Frame Frame1
Height = 675
Left = 30
TabIndex = 0
Top = 945
Width = 6750
Begin VB.TextBox Text1
BeginProperty Font
Name = "宋体"
Size = 10.5
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00C00000&
Height = 315
Left = 240
Locked = -1 'True
TabIndex = 3
Top = 240
Width = 4215
End
Begin VB.CommandButton Command1
Caption = "选择数据库路径(&S)"
Height = 375
Left = 4860
TabIndex = 2
Top = 210
Width = 1695
End
End
Begin VB.Label Label2
BackStyle = 0 'Transparent
Caption = $"InputOldData.frx":030E
ForeColor = &H0000FFFF&
Height = 645
Left = 900
TabIndex = 11
Top = 165
Width = 5430
End
Begin VB.Image Image1
Height = 480
Left = 165
Picture = "InputOldData.frx":03C4
Top = 60
Width = 480
End
Begin VB.Label Label1
BackColor = &H00404000&
BorderStyle = 1 'Fixed Single
ForeColor = &H0000FFFF&
Height = 960
Left = 45
TabIndex = 10
Top = -15
Width = 6750
End
End
Attribute VB_Name = "InputOldData"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Dim db As Database
Dim re As Recordset
Dim s As String
Dim InTr As String
Private Type BrowseInfo
hwndOwner As Long
pIDLRoot As Long
pszDisplayName As Long
lpszTitle As Long
ulFlags As Long
lpfnCallback As Long
lParam As Long
IIImage As Long
End Type
Private Const BIF_RETURNONLYFSDIRS = 1
Private Const MAX_PATH = 260
Private Declare Sub CoTaskMemFree Lib "ole32.dll" (ByVal hMem As Long)
Private Declare Function lstrcat Lib "kernel32" Alias "lstrcatA" (ByVal lpString1 As String, ByVal lpString2 As String) As Long
Private Declare Function SHBrowseForFolder Lib "shell32" (lpbi As BrowseInfo) As Long
Private Declare Function SHGetPathFromIDList Lib "shell32" (ByVal pidList As Long, ByVal lpBuffer As String) As Long
Private Sub Command1_Click()
On Error GoTo eh
s = BrowseForFolder(0, "请选择MND3.8电费处理系统的存放路径.")
Text1 = s
GzYue = Format(Month(Date), "0#")
Call sTruInfo
Set db = DBEngine.Workspaces(0).OpenDatabase(s, False, False, "FoxPro 2.5;")
'Set RE = DB.OpenRecordset("Select Distinct Xmc From Cdmk") ', dbOpenTable)
Set re = db.OpenRecordset("Cdmk")
Dim i As Integer
List1.Clear
For i = 0 To re.RecordCount - 1
List1.AddItem re.Fields!XDM & re.Fields!Cdm & Space(2) & Left(Trim(re.Fields!xmc) & Space(2), 4) & re.Fields!CMC & Space(2) & re.Fields!CBY
re.MoveNext
Next i
Command2(0).Enabled = True
Exit Sub
eh:
Select Case Err.Number
Case 3011
MsgBox "所选择路径不包含指定的MND3.8版的数据!", vbCritical
Text1.SelStart = 0
Text1.SelLength = Len(Text1)
Text1.SetFocus
Exit Sub
Case 3170
MsgBox "系统出错,原因:" & Err.Description & Chr(13) & "解决办法:安装相应的ISAM驱动程序！", vbCritical
Exit Sub
End Select
End Sub
Private Sub Command2_Click(Index As Integer)
Dim i As Integer
Select Case Index
Case 0 '全部选择
If List1.ListCount <> 0 Then
For i = 0 To List1.ListCount - 1
List1.Selected(i) = True
Next
List1.ListIndex = 0
End If
Case 1 '取消选择
If List1.ListCount <> 0 Then
For i = 0 To List1.ListCount - 1
List1.Selected(i) = False
Next
End If
Case 2 '开始导入
Dim VerStr As String
Dim db2 As Database
Dim RE2 As Recordset
Dim nSec As Long
Screen.MousePointer = 11
Command2(0).Enabled = False
Command2(1).Enabled = False
Command2(2).Enabled = False
Command2(3).Caption = "退出导入(&S)"
'导入镇档案
nSec = Timer
Set db2 = DBEngine.Workspaces(0).OpenDatabase(App.Path & "\Data\Eletricity.MDB")
Set RE2 = db2.OpenRecordset("乡镇档案")
If RE2.RecordCount <> 0 Then
db2.Execute "DELETE * From 乡镇档案"
End If
For i = 0 To List1.ListCount - 1
If List1.Selected(i) Then
If VerStr <> Mid(List1.List(i), 1, 2) Then
RE2.AddNew
RE2.Fields!全称 = "萧山供电局" & Mid(List1.List(i), 7, 4)
RE2.Fields!简称 = Mid(List1.List(i), 7, 4)
RE2.Fields!镇代码 = "0" & Mid(List1.List(i), 1, 2)
RE2.Fields!建档日期 = Format(Date, "YYYY年MM月DD日")
RE2.Fields!操作员 = Operator
RE2.Update
VerStr = Mid(List1.List(i), 1, 2)
End If
End If
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -