从 Word VBA 预设 Excel 的 GetOpenFilename 路径

Question

在 MS-Word 模板文件中使用主宏（因为最初它是 *dotm）。我需要打开一个 Excel 文件（每次打开一个具有不同路径的不同文件，由用户选择）。

我正在使用文件选择器，让用户选择所需的文件。

它始终在“MyDocument”默认文件夹路径打开文件选择器。

这是我的 MS-Word Master 代码：

'**********************************************
Set Excel_Tool = CreateObject("Excel.Application")
    
'Set  dialog box file filter
ID_Finfo = "Excel Files (*.xlsx; *.xls), *xlsx;*.xls"
'Set  dialog box caption title
Title = "Select an ID-file to open"
'Get  Filename
Excel_Path_Name = Excel_Tool.Application.GetOpenFilename(ID_Finfo, , Title, , False)

If Excel_Path_Name = "" Or Excel_Path_Name = "False" Then
    Response = msgbox("It Seems You Submitted a NOT VALID file/path data..." & vbCrLf & "            Pay More Attention, Please !!!" & vbCrLf & "        So, What Would You Like to Do, Now?       ", vbRetryCancel + vbExclamation)
    If Response = vbRetry Then
        Unload Me
        Call Open_ID_File_Form
    Else
        Unload Me
    End If
End If
'**********************************************

DIM 陈述是正确的；事实上，它会打开一个“MyDoc”默认浏览文件选择器窗口。

我尝试了两种方法：

Sub EXCEL_by_EXCEL_File_Open_PROVA_WEB()

Dim fileName

ChDrive "C:"
ChDir "C:\MY OWN Program files\test_excel opening"
Set Excel_Tool = CreateObject("Excel.Application")

fileName = Application.GetOpenFilename("Excel Files (*.xls;*.xlsx;*.xlsm), *xlsx;*.xls;*xlsm")

If fileName <> "False" Then
    Application.ScreenUpdating = False
    Workbooks.Open fileName, Format:=2
End If

End Sub

如果在 Excel 中启动，这可以工作，但如果在 Word 中调用，则失败（MyDoc 作为默认文件夹）。

我尝试通过复制剪贴板内的目标文件路径，然后要求用户将其粘贴到文件选择器路径字段来“欺骗系统”：

Def_Excel_Path_Name = ActiveDocument.Path & "\"

' this line sets the dir as the same of the word doc
' moving current WORD file path text to clipboard in order to allow  USER to workaround Word bug about "myDoc" as default folder

Dim Carrier As New DataObject
Carrier.SetText Def_Excel_Path_Name
Carrier.PutInClipboard

' now USER can paste it to address field on file picker window, in order to go straight to source document folder

它正在复制剪贴板上的文件夹路径，但是，当主宏打开文件选择器并且我尝试将剪贴板文本（源路径）粘贴到专用路径字段内时，没有复制任何内容。

如果我检查剪贴板内容，我会发现几个问号 -->“??”

Answer 1

只需使用“Excel.Application.DefaultFilePath”属性来设置您希望文件选择器框默认显示的位置：

将此行添加到您的第一个代码片段中：

　　Excel_Tool.Application.DefaultFilePath = Def_Excel_Path_Name

然后尝试一下：

    Dim Excel_Tool As Object, Def_Excel_Path_Name As String, ID_Finfo As String, Title As String, Excel_Path_Name As Variant, Response As VbMsgBoxResult
    
    Set Excel_Tool = CreateObject("Excel.Application")
    
    'Def_Excel_Path_Name = where to start
    Def_Excel_Path_Name = "w:\" 'set what you want to here
    Excel_Tool.Application.DefaultFilePath = Def_Excel_Path_Name
    'VBA.ChDir Def_Excel_Path_Name 'this just to apply the call side which as Word VBA NOT Excel Application
    
'    Excel_Tool.Quit 'if not quit after using or if without next line, this showing will be the last time's setting until restarting excel application object to apply.
    Set Excel_Tool = CreateObject("Excel.Application") 'restart excel.application object.this will create just one excel instance.
    
'Set  dialog box file filter
    ID_Finfo = "Excel Files (*.xlsx; *.xls), *xlsx;*.xls"
'Set  dialog box caption title
    Title = "Select an ID-file to open"
'Get  Filename
   Excel_Path_Name = Excel_Tool.Application.GetOpenFilename(ID_Finfo, , Title, , False)


If Excel_Path_Name = "" Or Excel_Path_Name = "False" Then
        Response = MsgBox("It Seems You Submitted a NOT VALID file/path data..." & vbCrLf & "            Pay More Attention, Please !!!" & vbCrLf & "        So, What Would You Like to Do, Now?       ", vbRetryCancel + vbExclamation)
        If Response = vbRetry Then
            Unload Me
            Call Open_ID_File_Form
        Else
            Unload Me
        End If
    End If

    Excel_Tool.Quit ' if without this , the setting of DefaultFilePath before would not apply properly

如果你想使用剪贴板功能试试这个:

Function ClipboardPutIn(Optional StoreText As String) As String 'https://www.thespreadsheetguru.com/blog/2015/1/13/how-to-use-vba-code-to-copy-text-to-the-clipboard
'PURPOSE: Read/Write to Clipboard
'Source: ExcelHero.com (Daniel Ferry)

Dim x As Variant

'Store as variant for 64-bit VBA support
  x = StoreText

'Create HTMLFile Object
  With CreateObject("htmlfile")
    DoEvents
    With .parentWindow.clipboardData
      Select Case True
        Case Len(StoreText)
          'Write to the clipboard
            .setData "text", x
        Case Else
          'Read from the clipboard (no variable passed through)
            ClipboardPutIn = .GetData("text")
      End Select
    End With
  End With

End Function