数据库备份时使用活动路径时出错,为什吗
tjr 2001-06-26 02:44:08 作数据库备份时,使用固定路径时正确,但使用活动路径时出错,活动路径存储在db.ini中,代码如下
我的初始化文件放在Module1中,代码如下:Option Explicit
Public cnn As String
Public Conn As ADODB.Connection
Sub Main()
Dim ini1 As New clsIniFile
Dim strFile As String
If App.PrevInstance Then
MsgBox ("程序已经运行,不能再次装载。"), vbExclamation
End
End If
If Not (FileExists(App.Path & "\db.ini")) Then
MsgBox "初始化文件丢失", vbOKOnly, "严重错误"
End
End If
Load frmSplash
frmSplash.Show
delay 0
Screen.MousePointer = vbHourglass
DoEvents
' Load frmMain
' frmMain.Enabled = False
Load frmMain1
frmMain1.Enabled = False
Set Conn = New ADODB.Connection
ini1.File = App.Path & "\db.ini"
strFile = ini1.GetSetting("系统", "数据文件")
If Not FileExists(strFile) Then
MsgBox "数据文件找不到.请首先进行系统设置->数据文件选择,然后退出系统,重新进入.", vbOKOnly, "提示"
With frmMain1
' With frmMain
.mnuQuery.Visible = False
.mnuFund.Visible = False
.mnuEquip.Visible = False
.mnuPublicBase.Visible = False
.Enabled = True
End With
frmLogin.Visible = False
Else
'设置连接字符串
'ACCESS2000格式
' cnn = "Provider=Microsoft.Jet.OLEDB.4.0;Persist Security Info=False;Jet OLEDB:Database Password=lq;Data Source=" & strFile
'ACCESS97格式
cnn = "Provider=Microsoft.Jet.OLEDB.3.51;Persist Security Info=False;Jet OLEDB:Database Password=lq;Data Source=" & strFile
'打开数据库
frmLogin.Show
On Error GoTo errDB
Conn.Open cnn
On Error GoTo 0
End If
1: Unload frmSplash
Screen.MousePointer = vbArrow
Exit Sub
errDB:
MsgBox "数据文件打不开.请首先进行系统设置->数据文件选择,然后退出系统,重新进入.", vbOKOnly, "提示"
With frmMain1
' With frmMain
.mnuQuery.Visible = False
.mnuFund.Visible = False
.mnuEquip.Visible = False
.mnuPublicBase.Visible = False
.Enabled = True
End With
frmLogin.Visible = False
Resume 1
Exit Sub
End Sub
别的文件使用该数据库都正常 ,但下面的backup database 处错,backup的mdb只有几K,无法用ACCESS打开
Dim Fso As New FileSystemObject
Dim Drv As Drive
Dim Fil As File
Private Sub cmdBackup_Click()
Dim BaseName As String
Dim FileExist As Boolean
Dim Response
' Set Fil = Fso.GetFile(App.Path & "\db.ini") '使用活动路径
Set Fil = Fso.GetFile("c:\lq\db97.mdb") '使用固定路径
If Right$(Dir1.Path, 1) = "\" Then
BaseName = Dir1.Path + Trim(txtFileName.Text)
Else
BaseName = Dir1.Path + "\" + Trim(txtFileName.Text)
End If
FileExist = Fso.FileExists(BaseName)
If FileExist = True Then
Response = MsgBox("指定文件已经存在,是否覆盖?", vbOKCancel, "确认覆盖")
If Response = vbOK Then
Fil.Copy BaseName, True
Exit Sub
Else
Exit Sub
End If
Else
Fil.Copy BaseName, True
End If
End Sub
后面代码略