📄 kyfrm.frm
字号:
VERSION 5.00
Object = "{FE0065C0-1B7B-11CF-9D53-00AA003C9CB6}#1.0#0"; "COMCT232.OCX"
Begin VB.Form kyfrm
BorderStyle = 1 'Fixed Single
Caption = "跨月数据处理"
ClientHeight = 2295
ClientLeft = 45
ClientTop = 330
ClientWidth = 5115
Icon = "kyfrm.frx":0000
LinkTopic = "Form1"
MaxButton = 0 'False
MinButton = 0 'False
ScaleHeight = 2295
ScaleWidth = 5115
StartUpPosition = 1 'CenterOwner
Begin VB.CommandButton Command2
Cancel = -1 'True
Caption = "退 出"
Height = 375
Left = 3000
TabIndex = 9
Top = 1800
Width = 855
End
Begin VB.CommandButton Command1
Caption = "确 定"
Height = 375
Left = 1080
TabIndex = 8
Top = 1800
Width = 855
End
Begin ComCtl2.UpDown UpDown3
Height = 375
Left = 3556
TabIndex = 7
Top = 1080
Width = 270
_ExtentX = 476
_ExtentY = 661
_Version = 327681
BuddyControl = "Text2"
BuddyDispid = 196612
OrigLeft = 3840
OrigTop = 1080
OrigRight = 4110
OrigBottom = 1455
SyncBuddy = -1 'True
BuddyProperty = 65547
Enabled = -1 'True
End
Begin VB.TextBox Text2
Alignment = 2 'Center
Height = 375
Left = 2880
Locked = -1 'True
TabIndex = 3
Top = 1080
Width = 675
End
Begin ComCtl2.UpDown UpDown1
Height = 375
Left = 2026
TabIndex = 2
Top = 1080
Width = 270
_ExtentX = 476
_ExtentY = 661
_Version = 327681
BuddyControl = "Text1"
BuddyDispid = 196614
OrigLeft = 1800
OrigTop = 1320
OrigRight = 2070
OrigBottom = 1695
SyncBuddy = -1 'True
BuddyProperty = 65547
Enabled = -1 'True
End
Begin VB.TextBox Text1
Alignment = 2 'Center
Height = 375
Left = 1080
Locked = -1 'True
TabIndex = 1
Top = 1080
Width = 945
End
Begin ComCtl2.UpDown UpDown2
Height = 375
Left = 2026
TabIndex = 4
Top = 1080
Width = 270
_ExtentX = 476
_ExtentY = 661
_Version = 327681
BuddyControl = "Text1"
BuddyDispid = 196614
OrigLeft = 1800
OrigTop = 1320
OrigRight = 2070
OrigBottom = 1695
SyncBuddy = -1 'True
BuddyProperty = 65547
Enabled = -1 'True
End
Begin VB.Label Label4
Height = 255
Left = 0
TabIndex = 10
Top = 1560
Width = 2535
End
Begin VB.Label Label3
Caption = "月"
BeginProperty Font
Name = "黑体"
Size = 15
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 375
Left = 3840
TabIndex = 6
Top = 1080
Width = 495
End
Begin VB.Label Label2
Caption = "年"
BeginProperty Font
Name = "黑体"
Size = 15
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 375
Left = 2400
TabIndex = 5
Top = 1080
Width = 495
End
Begin VB.Label Label1
Caption = " 每月数据处理完毕后，再进行此项工作，功能是把本月的数据进行备份并进行表码处理等，份备后不能再进行恢复。"
BeginProperty Font
Name = "仿宋_GB2312"
Size = 10.5
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00FF0000&
Height = 735
Left = 240
TabIndex = 0
Top = 240
Width = 4305
End
End
Attribute VB_Name = "kyfrm"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Public sj As Database
Public tmpsql As Recordset
Public old1 As Database, myold As Workspace
Private Sub Command1_Click()
file1 = App.Path + "\oldsj\cjsj" + Text1 + Text2 + ".mdb"
If Dir(file1) <> "" Then
ab1 = MsgBox(Text1 + "年" + Text2 + "月的数据已数据完毕，重新处理吗？", vbYesNo + 16, "提示")
Else
ab = MsgBox("确认要处理：" + Text1 + "年" + Text2 + "月的数据吗？", vbYesNo + 48, "提示")
End If
If ab = 6 Then
Set myold = DBEngine.Workspaces(0)
Set old1 = myold.CreateDatabase(file1, dbLangGeneral, dbVersion03)
old1.Close
Label4.Caption = "正在备份处理用户数据....."
abm = "select * into bk in '" + file1 + "' from bk;"
sj.Execute abm
Label4.Caption = "正在备份处理村名数据....."
abm = "select * into cm in '" + file1 + "' from cm;"
sj.Execute abm
Label4.Caption = "正在备份处理电价数据....."
abm = "select * into dj in '" + file1 + "' from dj;"
sj.Execute abm
Label4.Caption = "正在备份处理单位数据....."
abm = "select * into dwk in '" + file1 + "' from dwk;"
sj.Execute abm
abm = "update bk set sybm=bybm,ch=xbch,bl=xbbl,sydl=bydl where xbch<>'';"
sj.Execute abm
abm = "update bk set xbch='',xbbl=0,bqm=0,bzm=0,bydl=0,ysdf=0,jjdl=0;"
sj.Execute abm
abm = "update cm set dybz=false,jsbz=false"
Command1.Enabled = False
Label4.Caption = ""
End If
If ab1 = 6 Then
Kill file1
Set myold = DBEngine.Workspaces(0)
Set old1 = myold.CreateDatabase(file1, dbLangGeneral, dbVersion03)
old1.Close
Label4.Caption = "正在备份处理用户数据....."
abm = "select * into bk in '" + file1 + "' from bk;"
sj.Execute abm
Label4.Caption = "正在备份处理村名数据....."
abm = "select * into cm in '" + file1 + "' from cm;"
sj.Execute abm
Label4.Caption = "正在备份处理电价数据....."
abm = "select * into dj in '" + file1 + "' from dj;"
sj.Execute abm
Label4.Caption = "正在备份处理单位数据....."
abm = "select * into dwk in '" + file1 + "' from dwk;"
sj.Execute abm
abm = "select * into dwk in '" + file1 + "' from dwk;"
sj.Execute abm
abm = "update bk set sybm=bybm,ch=xbch,bl=xbbl,sydl=bydl where xbch<>'';"
sj.Execute abm
abm = "update bk set xbch='',xbbl=0,bqm=0,bzm=0,bydl=0,ysdf=0,jjdl=0;"
sj.Execute abm
abm = "update cm set dybz=false,jsbz=false"
Command1.Enabled = False
Label4.Caption = ""
End If
'If ab = 6 Then
' Source1 = App.Path + "\data\cjsj.mdb"
' file1 = App.Path + "\oldsj\cjsj" + Text1 + Text2 + ".mdb"
'FileCopy Source1, file1
'End If
'FileCopy "d:\cjdf\data\111.mdb", "d:\cjdf\oldsj\cjsj.mdb"
'sj.Connect = ";pwd=''"
'Set myold = DBEngine.Workspaces(0)
'Set old1 = myold.CreateDatabase("d:\cjdf\oldsj\cjsj20005.mdb", dbLangGeneral, dbVersion03)
'ab = "select * into bk in 'd:\cjdf\oldsj\cjsj20005.mdb' from bk;"
'MsgBox ab
'sj.Execute ab
End Sub
Private Sub Command2_Click()
Unload Me
End Sub
Private Sub Form_Load()
UpDown1.Max = 2050
UpDown1.Min = 1995
Text1.Text = Year(Now)
UpDown3.Max = 12
UpDown3.Min = 1
Text2.Text = Month(Now)
tmp = App.Path + "\data\cjsj.mdb"
Set sj = OpenDatabase(tmp, False, False, ";pwd=sunlm")
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -