📄 数据备份.frm
字号:
VERSION 5.00
Begin VB.Form 数据备份
Caption = "图书管理系统"
ClientHeight = 4305
ClientLeft = 5880
ClientTop = 1920
ClientWidth = 4470
LinkTopic = "Form1"
LockControls = -1 'True
MaxButton = 0 'False
ScaleHeight = 4305
ScaleWidth = 4470
Begin VB.DriveListBox Drv1
Height = 300
Left = 1320
TabIndex = 3
Top = 240
Width = 2895
End
Begin VB.DirListBox Dir1
Height = 2190
Left = 1320
TabIndex = 2
Top = 720
Width = 2895
End
Begin VB.TextBox Txtfilename1
Height = 375
Left = 1320
TabIndex = 1
Top = 3000
Width = 2895
End
Begin VB.CommandButton save
Caption = "存储"
Height = 375
Left = 1680
TabIndex = 0
Top = 3720
Width = 855
End
Begin VB.Label Label21
AutoSize = -1 'True
Caption = "文件路径"
Height = 180
Left = 240
TabIndex = 6
Top = 720
Width = 720
End
Begin VB.Label Label22
AutoSize = -1 'True
Caption = "文件名称"
Height = 180
Left = 240
TabIndex = 5
Top = 3000
Width = 720
End
Begin VB.Label Label23
AutoSize = -1 'True
Caption = "逻辑盘符"
Height = 180
Left = 240
TabIndex = 4
Top = 240
Width = 720
End
End
Attribute VB_Name = "数据备份"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Private Sub Drv1_Change()
Dir1.Path = Drv1.Drive
End Sub
Private Sub Dir1_Change()
If Trim(Txtfilename1) = "" Then
Txtfilename1 = Dir1.Path + "\"
Else
Txtfilename1 = Dir1.Path + "\" + Right(Txtfilename1, Len(Txtfilename1) - InStrRev(Txtfilename1, "\"))
End If
End Sub
Private Sub Form_Load()
Txtfilename1 = Dir1.Path + "\"
End Sub
Private Sub Form_Unload(Cancel As Integer)
系统操作.Show
End Sub
Private Sub save_Click()
On Error GoTo ERR
Dim strSource As String
Dim strDestfile As String
Dim fso As New Scripting.FileSystemObject
Dim fil As Scripting.File
'输入备份文件名
strDestfile = Trim(Right(Txtfilename1, Len(Txtfilename1) - InStrRev(Txtfilename1, "\")))
If strDestfile = "" Then
MsgBox "请您输入备份文件名!"
Txtfilename1.SetFocus
ERR.Raise 3001
Else
strSource = App.Path + "\Libarary.mdb"
'若不存在源文件,则报错
If Not fso.FileExists(strSource) Then MsgBox "源文件不存在": ERR.Raise 3001
'若存在目的备份文件,则先删除
If fso.FileExists(Txtfilename1) Then
If MsgBox("是否要删除目的备份文件?", vbOKCancel) = vbCancel Then MsgBox "请你换个备份文件名": Txtfilename1.SetFocus: ERR.Raise 3001
fso.DeleteFile Txtfilename1
End If
fso.CopyFile strSource, Txtfilename1, True
MsgBox "备份完毕"
Unload Me
End If
Exit Sub
ERR:
If ERR.Number = 3001 Then Exit Sub
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -