为了允许Access数据库的可移植性,如果要复制文件夹到另一台计算机,我想强迫用户选择其文件夹。但是,在尝试测试文件夹的路径时遇到了绊脚石。
在下面的代码中,未注释掉if
语句块,但上面的while
语句无效。我得到:
运行时错误'5':无效的过程调用或参数。
我看过Tools > References
,并且适当的部件似乎已经准备就绪。我已经尝试过fd.SelectedItems.Count = 0
,但这并不能防止传递不需要的字符串。
Private Sub btn_CorrectPath_Click()
Dim sHostName As String, strSQL As String, sFolder As String
Dim rs As Recordset, db As Database, fd As FileDialog
Dim intResult As Integer
Set db = CurrentDb
' Get Host Name / Get Computer Name
sHostName = Environ$("computername")
Set rs = CurrentDb.OpenRecordset("SELECT * FROM t_ComputerInfo")
If rs!ComputerName <> sHostName Then
Set fd = Application.FileDialog(msoFileDialogFolderPicker)
fd.AllowMultiSelect = False
fd.Title = "Select database folder"
intResult = fd.Show
While intResult = False
intResult = fd.Show
While fd.SelectedItems(1) = vbNullString 'folder path was not selected
intResult = fd.Show
Wend
Wend
sFolder = fd.SelectedItems(1)
strSQL = "UPDATE t_ComputerInfo SET [t_ComputerInfo].[ComputerName] = '" & sHostName & _
& " [t_ComputerInfo].[DBPath] = '" & sFolder & "' WHERE [t_ComputerInfo].[ID] = 1"
CurrentDb.Execute strSQL, dbFailOnError
' If fd.Show = True Then 'Action button was pressed
' MsgBox ("Directory was given. fd.SelectedItems(1)= " & fd.SelectedItems(1))
' If fd.SelectedItems(1) <> vbNullString Then
' sFolder = fd.SelectedItems(1)
' strSQL = "UPDATE t_ComputerInfo SET [t_ComputerInfo].[ComputerName] = '" & sHostName & _
"', [t_ComputerInfo].[DBPath] = '" & sFolder & "' WHERE [t_ComputerInfo].[ID] = 1"
' MsgBox ("SQL statement = " & vbCrLf & strSQL)
' CurrentDb.Execute strSQL, dbFailOnError
' End If
' Else 'Cancel button was pressed
' sFolder = fd.SelectedItems(1)
' MsgBox ("The location of the database is required and will be requested later. fd.SelectedItems(1)= " & sFolder)
' End If
Set fd = Nothing
End If
db.Close
End Sub
我看不到需要嵌套While。考虑:
Dim booResult As Boolean
...
While booResult = False
If fd.Show = True Then 'folder path was selected
booResult = True
sFolder = fd.SelectedItems(1)
End If
Wend
首先,请注意,您在此串联中将与号加倍了:
strSQL = "UPDATE t_ComputerInfo SET [t_ComputerInfo].[ComputerName] = '" & sHostName & _
& " [t_ComputerInfo].[DBPath] = '" & sFolder & "' WHERE [t_ComputerInfo].[ID] = 1"
^----- Here
对于您的其余代码,我相信您可以完全删除while
循环(除非您真的希望用户在选择文件夹之前一直陷入循环……?)。>
我可能会提出以下建议:
Private Sub btn_CorrectPath_Click() Dim fld As String Dim pcn As String pcn = Environ$("computername") If Nz(DLookup("computername", "t_computerinfo"), "") <> pcn Then With Application.FileDialog(4) .AllowMultiSelect = False .Title = "Select Database Folder" If .Show Then fld = .selecteditems(1) End With If fld <> "" Then With CurrentDb.CreateQueryDef("", "update t_computerinfo t set t.computername = @pc, t.dbpath = @pth where t.id = 1") .Parameters(0) = pcn .Parameters(1) = fld .Execute dbFailOnError End With End If End If End Sub
[这里,我用
DLookup
代替打开记录集,因为在查询单个值时这似乎是过分的,但是,您可能希望为DLookup
提供一些条件。
我还使用了连接值的参数化SQL语句,因为这是更好的做法,并且还可以处理数据类型。