📄 datesave。frm.frm
字号:
VERSION 5.00
Begin VB.Form datesave
Caption = "备份"
ClientHeight = 5100
ClientLeft = 135
ClientTop = 420
ClientWidth = 7455
LinkTopic = "Form1"
ScaleHeight = 5100
ScaleWidth = 7455
StartUpPosition = 3 '窗口缺省
Begin VB.Frame frameCurrBackUp
BackColor = &H00C0C0C0&
Caption = "选择备份路径"
BeginProperty Font
Name = "MS Sans Serif"
Size = 12
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00FF0000&
Height = 4455
Left = 0
TabIndex = 0
Top = 0
Width = 7455
Begin VB.FileListBox File1
Height = 2430
Left = 3960
TabIndex = 5
Top = 480
Width = 2775
End
Begin VB.CommandButton cmdCancel
BackColor = &H00FFFFFF&
Caption = "取消(&C)"
Height = 735
Left = 4800
Picture = "datesave。frm.frx":0000
Style = 1 'Graphical
TabIndex = 4
Top = 3360
Width = 1095
End
Begin VB.CommandButton cmdSave
BackColor = &H00FFFFFF&
Caption = "备份(&B)"
Height = 735
Left = 1560
Picture = "datesave。frm.frx":0381
Style = 1 'Graphical
TabIndex = 3
Top = 3360
Width = 1215
End
Begin VB.DirListBox Dir1
Height = 1980
Left = 480
TabIndex = 2
Top = 960
Width = 3015
End
Begin VB.DriveListBox Drive1
Height = 300
Left = 480
TabIndex = 1
Top = 480
Width = 3015
End
End
End
Attribute VB_Name = "datesave"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'Dim Fsys As New FileSystemObject
'Dim bckupFile As File
Private Sub cmdCancel_Click()
Unload Me
frm_main.Show
frm_main.Enabled = True
End Sub
Private Sub cmdsave_click()
On Error Resume Next
cmdSave.Enabled = False
Dim destination As String
Dim Source As String
Dim currDate, currTime As String
currDate = Format$(Now, "mm - dd - yy")
currTime = Format$(Now, "hh:mm:ss AM/PM")
destination = File1.Path & "\" & "医院药品进销存系统.mdb"
Source = App.Path & "\医院药品进销存系统.mdb"
Set bckupFile = Fsys.GetFile(finalpath)
bckupFile.Attributes = Compressed
Fsys.CopyFile Source, destination, True
'Saving Current Backup Details
SaveSetting App.Title, "Settings", "BackupPath", destination
SaveSetting App.Title, "Settings", "BackupDate", currDate
SaveSetting App.Title, "Settings", "BackupTime", currTime
cmdSave.Enabled = True
MsgBox "备份完成!", vbInformation, "备份"
Unload Me
frm_main.Show
frm_main.Enabled = True
End Sub
Private Sub Drive1_Change()
Dir1.Path = Drive1.Drive
End Sub
Private Sub Dir1_Change()
File1.Path = Dir1.Path
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -