我可以在Access中指定Application.FileDialog的位置吗?

时间:2017-07-22 01:43:25

标签: vba ms-access

我有一个Access弹出窗体(Auto Center = Yes),上面有按钮,要求用户选择要带入Access表的特定文件。按钮后面的代码调用模块中的函数getfileName(),该函数使用Application.FileDialog对象创建一个表单,用户将使用该表单导航到相应的文件夹以选择文件。然后将该文件的完整路径分配给该函数,并在DoCmd.TransferSpreadsheet代码行中的表单代码中使用。这一切都很好,所以功能不是问题。一个按钮让用户获得一个文件,对话框在屏幕中居中,就像表单一样。第二个按钮让用户获得两个文件;第一个对话框居中,但第二个对话框位于屏幕的左上角。我希望所有对话框都在屏幕上居中,但文件对话框对象似乎没有像Form对象那样的任何属性,例如 Auto Center。我没有在在线文档中找到任何可以帮助我在Application.FileDialog对象时保持对话框居中的内容。有什么指针吗?

这是功能:

Global path As String

Function getFileName(xMessage As String) As String

Dim fDialog As Object

Dim varFile As Variant
Dim importFile As String


' Set up the File Dialog.
Set fDialog = Application.FileDialog(msoFileDialogFilePicker)

With fDialog

    ' Don't allow user to make multiple selections in dialog box
    .AllowMultiSelect = False

    ' Make the path directly to the folder where the dated folders are located
    ' For the first time through, the global variable path="", so assign the parent folder. After that,
    ' path is assigned the parent folder of the files being used.
    If Len(path) = 0 Then
        .InitialFileName = "\\server\share$\Parent Directory\Directory\"
    End If

    ' Set the title of the dialog box.
    If xMessage = "" Then
      .Title = "Please select the new file"
    Else
      .Title = xMessage
    End If

    ' Clear out the current filters, and add our own.
    .Filters.Clear
    .Filters.Add "Access Databases", "*.XLSX"
    .Filters.Add "All Files", "*.*"

    ' Show the dialog box. If the .Show method returns True, the
    ' user picked at least one file. If the .Show method returns
    ' False, the user clicked Cancel.

    If .Show = True Then

         'Loop through each file selected (there is only one) and add it to our list box.
        For Each varFile In .SelectedItems
            importFile = varFile
        Next
        'Set the file name selected to the function name
        getFileName = importFile
    Else

         ' MsgBox "You clicked Cancel in the file dialog box."
         getFileName = ""
    End If

    'Save directory to global variable "path"
    path = getDirectoryPath(getFileName)

End With

Exit Function
End Function

0 个答案:

没有答案