📄 删除数据.frm
字号:
VERSION 5.00
Object = "{F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.2#0"; "comdlg32.ocx"
Begin VB.Form 删除数据
BackColor = &H008080FF&
BorderStyle = 3 'Fixed Dialog
ClientHeight = 2775
ClientLeft = 1935
ClientTop = 2625
ClientWidth = 8220
ControlBox = 0 'False
LinkTopic = "Form1"
MaxButton = 0 'False
MinButton = 0 'False
Moveable = 0 'False
ScaleHeight = 2775
ScaleWidth = 8220
ShowInTaskbar = 0 'False
Begin MSComDlg.CommonDialog CommonDialog1
Left = 1320
Top = 1800
_ExtentX = 847
_ExtentY = 847
_Version = 393216
PrinterDefault = 0 'False
End
Begin VB.CommandButton Command2
Caption = "确 定"
BeginProperty Font
Name = "宋体"
Size = 10.5
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 375
Left = 6000
TabIndex = 2
Top = 1830
Width = 1185
End
Begin VB.CommandButton Command1
Caption = "取 消"
BeginProperty Font
Name = "宋体"
Size = 10.5
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 375
Left = 4800
TabIndex = 1
Top = 1830
Width = 1185
End
Begin VB.Data Data1
Caption = "Data1"
Connect = "Access"
DatabaseName = ""
DefaultCursorType= 0 '缺省游标
DefaultType = 2 '使用 ODBC
Exclusive = 0 'False
Height = 345
Left = 1680
Options = 0
ReadOnly = 0 'False
RecordsetType = 1 'Dynaset
RecordSource = "日期车次"
Top = 4560
Visible = 0 'False
Width = 1845
End
Begin VB.Data Data2
Caption = "Data2"
Connect = "Access"
DatabaseName = ""
DefaultCursorType= 0 '缺省游标
DefaultType = 2 '使用 ODBC
Exclusive = 0 'False
Height = 345
Left = 4320
Options = 0
ReadOnly = 0 'False
RecordsetType = 1 'Dynaset
RecordSource = "日期车次"
Top = 5880
Visible = 0 'False
Width = 2475
End
Begin VB.Data Data5
Caption = "Data5"
Connect = "Access"
DatabaseName = ""
DefaultCursorType= 0 '缺省游标
DefaultType = 2 '使用 ODBC
Exclusive = 0 'False
Height = 345
Left = 1440
Options = 0
ReadOnly = 0 'False
RecordsetType = 1 'Dynaset
RecordSource = ""
Top = 5160
Visible = 0 'False
Width = 1695
End
Begin VB.Data Data4
Caption = "Data4"
Connect = "Access"
DatabaseName = ""
DefaultCursorType= 0 '缺省游标
DefaultType = 2 '使用 ODBC
Exclusive = 0 'False
Height = 345
Left = 3720
Options = 0
ReadOnly = 0 'False
RecordsetType = 1 'Dynaset
RecordSource = ""
Top = 5280
Visible = 0 'False
Width = 1845
End
Begin VB.Label Label2
BackStyle = 0 'Transparent
Caption = "现在将删除全部记录 ！ "
BeginProperty Font
Name = "华文新魏"
Size = 24
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H8000000E&
Height = 675
Left = 1650
TabIndex = 3
Top = 810
Width = 5835
End
Begin VB.Label Label1
BackStyle = 0 'Transparent
Caption = "正在做记录删除， 请稍候 ！"
BeginProperty Font
Name = "华文新魏"
Size = 24
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00FFFFFF&
Height = 1065
Left = 1080
TabIndex = 0
Top = 810
Visible = 0 'False
Width = 6795
End
End
Attribute VB_Name = "删除数据"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Private Declare Function GetDiskFreeSpace Lib "kernel32" Alias "GetDiskFreeSpaceA" (ByVal lpRootPathName As String, lpSectorsPerCluster As Long, lpBytesPerSector As Long, lpNumberOfFreeClusters As Long, lpTtoalNumberOfClusters As Long) As Long
Dim FileName1, FileName2 As String
Private Sub Command1_Click()
工作选项.Show
工作选项.Enabled = True
Unload Me
End Sub
Private Sub Command2_Click()
Dim Result As Integer, I As Integer
Dim BzData(6) As String
Result = MsgBox(" 是否保存当前数据 ！ ", vbQuestion + vbYesNo, "提示信息")
If Result = 6 Then
Call SaveFile
End If
Data1.DatabaseName = FileName2
If Mid(FileName2, 4, 20) = "原始记录.mdb" Then
Debug.Print "aaa"
End If
'Label2.Visible = False
'Label1.Visible = True
'Data1.DatabaseName = App.Path + "\" + "原始记录.mdb"
'Data2.DatabaseName = App.Path + "\" + "原始记录.mdb"
'Data4.DatabaseName = App.Path + "\" + "原始记录.mdb"
'Data5.DatabaseName = App.Path + "\" + "班组统计.mdb"
' BzData(1) = "第一组": BzData(2) = "第二组"
' BzData(3) = "第三组": BzData(4) = "第四组"
' BzData(5) = "第五组": BzData(6) = "第六组"
' BzData(7) = "第七组": BzData(8) = "第八组"
'Data1.Refresh
'Do While Data1.Recordset.EOF = False
' Data1.Recordset.Delete
' Data1.Recordset.MoveNext
'Loop
' For I = 1 To 8
' Select Case BzData(I)
' Case "第一组"
' Data4.RecordSource = "A1"
' Case "第二组"
' Data4.RecordSource = "A2"
' Case "第三组"
' Data4.RecordSource = "A3"
' Case "第四组"
' Data4.RecordSource = "A4"
' Case "第五组"
' Data4.RecordSource = "A5"
' Case "第六组"
' Data4.RecordSource = "A6"
' Case "第七组"
' Data4.RecordSource = "A7"
' Case "第八组"
' Data4.RecordSource = "A8"
' End Select
' Data4.Refresh
' Do While Data4.Recordset.EOF = False
' Data4.Recordset.Delete
' Data4.Recordset.MoveNext
' Loop
' Next I
' For I = 1 To 8
' Select Case BzData(I)
' Case "第一组"
' Data4.RecordSource = "C1"
' Case "第二组"
' Data4.RecordSource = "C2"
' Case "第三组"
' Data4.RecordSource = "C3"
' Case "第四组"
' Data4.RecordSource = "C4"
' Case "第五组"
' Data4.RecordSource = "C5"
' Case "第六组"
' Data4.RecordSource = "C6"
' Case "第七组"
' Data4.RecordSource = "C7"
' Case "第八组"
' Data4.RecordSource = "C8"
' End Select
' Data4.Refresh
' Do While Data4.Recordset.EOF = False
' Data4.Recordset.Delete
' Data4.Recordset.MoveNext
' Loop
' Next I
'
' For I = 1 To 8
' Select Case BzData(I)
' Case "第一组"
' Data5.RecordSource = "B1"
' Case "第二组"
' Data5.RecordSource = "B2"
' Case "第三组"
' Data5.RecordSource = "B3"
' Case "第四组"
' Data5.RecordSource = "B4"
' Case "第五组"
' Data5.RecordSource = "B5"
' Case "第六组"
' Data5.RecordSource = "B6"
' Case "第七组"
' Data5.RecordSource = "B7"
' Case "第八组"
' Data5.RecordSource = "B8"
' End Select
' Data5.Refresh
' Do While Data5.Recordset.EOF = False
' Data5.Recordset.Delete
' Data5.Recordset.MoveNext
' Loop
' Next I
' For I = 1 To 8
' Select Case BzData(I)
' Case "第一组"
' Data5.RecordSource = "J1"
' Case "第二组"
' Data5.RecordSource = "J2"
' Case "第三组"
' Data5.RecordSource = "J3"
' Case "第四组"
' Data5.RecordSource = "J4"
' Case "第五组"
' Data5.RecordSource = "J5"
' Case "第六组"
' Data5.RecordSource = "J6"
' Case "第七组"
' Data5.RecordSource = "J7"
' Case "第八组"
' Data5.RecordSource = "J8"
' End Select
' Data5.Refresh
' Do While Data5.Recordset.EOF = False
' Data5.Recordset.Delete
' Data5.Recordset.MoveNext
' Loop
' Next I
' Result = MsgBox(" 记录删除完毕 ！ ", vbExclamation + vbOKOnly, "提示信息")
' If Result = 1 Then
' 工作选项.Show
' 工作选项.Enabled = True
' Unload Me
' End If
End Sub
Private Sub SaveFile()
Dim Dd As String, Gg As Single, Tt As Single, Sectors As Long, Bytes As Long, FreeC As Long, TotalC As Long
CommonDialog1.Filter = "*.mdb|*.mdb"
CommonDialog1.ShowOpen
FileName1 = CommonDialog1.FileName
CommonDialog1.ShowSave
FileName2 = CommonDialog1.FileName
If CommonDialog1.FileName = "" Then
MsgBox " 文件名不能为空 ！ ", vbExclamation + vbOKOnly
End If
Dd = Mid(FileName2, 1, 3)
GetDiskFreeSpace Dd, Sectors, Bytes, FreeC, TotalC
Tt = Sectors * TotalC / 1024
Tt = Tt * Bytes
Gg = Sectors * Bytes
Gg = Gg * FreeC
If FileName1 = FileName2 Then
MsgBox " 文件重名，请更改文件名或另存它处 ！", vbExclamation
CommonDialog1.ShowSave
FileName2 = CommonDialog1.FileName
End If
If Gg < FileLen(FileName1) Then
MsgBox " 磁盘空间不够，请另存它处或调换磁盘 ！ ", vbExclamation
Exit Sub
End If
FileCopy FileName1, FileName2
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -