excel - VBA提示“打开”对话框并选择要从中导入导入的目录

Question

我有这个 VBA 代码，我需要一些帮助。它的目的是根据 excel 文档中的参数生成文字报告，到目前为止一切都很好。问题是我想将相同的模板分发给同事，而无需他们更改代码。以其当前形式，它从代码中指定的目录中打开一个 excel 文档。我想将其更改为从用户选择的 excel 文档中检索信息。我已经阅读了 GetOpenFilename 方法，它应该提示对话框“打开”，但没有设法让它工作。感谢任何建议。

Private Sub Document_Open()

Dim objExcel As New Excel.Application
Dim exWb As Excel.Workbook

Set exWb = objExcel.Workbooks.Open("C:\Users\Document.xlsx")

ThisDocument.number_name.Caption = exWb.Sheets("Reporting").Cells(4, 2)
ThisDocument.period.Caption = exWb.Sheets("Reporting").Cells(3, 2)

ThisDocument.nr_persons.Caption = exWb.Sheets("Reporting").Cells(6, 2)
ThisDocument.total_people.Caption = exWb.Sheets("Reporting").Cells(6, 3)
ThisDocument.nr_subcontracts.Caption = exWb.Sheets("Reporting").Cells(7, 2)
ThisDocument.thrid_party.Caption = exWb.Sheets("Reporting").Cells(8, 2)
ThisDocument.travel_costs.Caption = exWb.Sheets("Reporting").Cells(9, 2)
ThisDocument.depreciation.Caption = exWb.Sheets("Reporting").Cells(10, 2)
ThisDocument.other_costs.Caption = exWb.Sheets("Reporting").Cells(11, 2)

ThisDocument.res23sec.Caption = exWb.Sheets("Reporting").Cells(37, 3)
ThisDocument.res29sec.Caption = exWb.Sheets("Reporting").Cells(43, 3)
ThisDocument.res33sec.Caption = exWb.Sheets("Reporting").Cells(47, 3)
ThisDocument.res33ter.Caption = exWb.Sheets("Reporting").Cells(47, 4)

ThisDocument.res1.Caption = exWb.Sheets("Reporting").Cells(15, 2)
ThisDocument.res2.Caption = exWb.Sheets("Reporting").Cells(16, 2)
ThisDocument.res3.Caption = exWb.Sheets("Reporting").Cells(17, 2)
ThisDocument.res4.Caption = exWb.Sheets("Reporting").Cells(18, 2)
ThisDocument.res5.Caption = exWb.Sheets("Reporting").Cells(19, 2)
ThisDocument.res6.Caption = exWb.Sheets("Reporting").Cells(20, 2)
ThisDocument.res7.Caption = exWb.Sheets("Reporting").Cells(21, 2)
ThisDocument.res8.Caption = exWb.Sheets("Reporting").Cells(22, 2)
ThisDocument.res9.Caption = exWb.Sheets("Reporting").Cells(23, 2)
ThisDocument.res10.Caption = exWb.Sheets("Reporting").Cells(24, 2)
ThisDocument.res11.Caption = exWb.Sheets("Reporting").Cells(25, 2)
ThisDocument.res12.Caption = exWb.Sheets("Reporting").Cells(26, 2)
ThisDocument.res13.Caption = exWb.Sheets("Reporting").Cells(27, 2)
ThisDocument.res14.Caption = exWb.Sheets("Reporting").Cells(28, 2)
ThisDocument.res15.Caption = exWb.Sheets("Reporting").Cells(29, 2)
ThisDocument.res16.Caption = exWb.Sheets("Reporting").Cells(30, 2)
ThisDocument.res17.Caption = exWb.Sheets("Reporting").Cells(31, 2)
ThisDocument.res18.Caption = exWb.Sheets("Reporting").Cells(32, 2)
ThisDocument.res19.Caption = exWb.Sheets("Reporting").Cells(33, 2)
ThisDocument.res20.Caption = exWb.Sheets("Reporting").Cells(34, 2)
ThisDocument.res21.Caption = exWb.Sheets("Reporting").Cells(35, 2)
ThisDocument.res22.Caption = exWb.Sheets("Reporting").Cells(36, 2)
ThisDocument.res23.Caption = exWb.Sheets("Reporting").Cells(37, 2)
ThisDocument.res24.Caption = exWb.Sheets("Reporting").Cells(38, 2)
ThisDocument.res25.Caption = exWb.Sheets("Reporting").Cells(39, 2)
ThisDocument.res26.Caption = exWb.Sheets("Reporting").Cells(40, 2)
ThisDocument.res27.Caption = exWb.Sheets("Reporting").Cells(41, 2)
ThisDocument.res28.Caption = exWb.Sheets("Reporting").Cells(42, 2)
ThisDocument.res29.Caption = exWb.Sheets("Reporting").Cells(43, 2)
ThisDocument.res30.Caption = exWb.Sheets("Reporting").Cells(44, 2)
ThisDocument.res31.Caption = exWb.Sheets("Reporting").Cells(45, 2)
ThisDocument.res32.Caption = exWb.Sheets("Reporting").Cells(46, 2)
ThisDocument.res33.Caption = exWb.Sheets("Reporting").Cells(47, 2)
ThisDocument.res34.Caption = exWb.Sheets("Reporting").Cells(48, 2)
ThisDocument.res35.Caption = exWb.Sheets("Reporting").Cells(49, 2)
ThisDocument.res36.Caption = exWb.Sheets("Reporting").Cells(50, 2)
ThisDocument.res37.Caption = exWb.Sheets("Reporting").Cells(51, 2)
ThisDocument.res38.Caption = exWb.Sheets("Reporting").Cells(52, 2)
ThisDocument.res39.Caption = exWb.Sheets("Reporting").Cells(53, 2)
ThisDocument.res40.Caption = exWb.Sheets("Reporting").Cells(54, 2)
ThisDocument.res41.Caption = exWb.Sheets("Reporting").Cells(55, 2)
ThisDocument.res42.Caption = exWb.Sheets("Reporting").Cells(56, 2)
ThisDocument.res43.Caption = exWb.Sheets("Reporting").Cells(57, 2)
ThisDocument.res44.Caption = exWb.Sheets("Reporting").Cells(58, 2)
ThisDocument.res45.Caption = exWb.Sheets("Reporting").Cells(59, 2)
ThisDocument.res46.Caption = exWb.Sheets("Reporting").Cells(60, 2)
ThisDocument.res47.Caption = exWb.Sheets("Reporting").Cells(61, 2)
ThisDocument.res48.Caption = exWb.Sheets("Reporting").Cells(62, 2)
ThisDocument.res49.Caption = exWb.Sheets("Reporting").Cells(63, 2)
ThisDocument.res50.Caption = exWb.Sheets("Reporting").Cells(64, 2)
ThisDocument.res51.Caption = exWb.Sheets("Reporting").Cells(65, 2)
ThisDocument.res52.Caption = exWb.Sheets("Reporting").Cells(66, 2)
ThisDocument.res53.Caption = exWb.Sheets("Reporting").Cells(67, 2)
ThisDocument.res54.Caption = exWb.Sheets("Reporting").Cells(68, 2)
ThisDocument.res55.Caption = exWb.Sheets("Reporting").Cells(69, 2)
ThisDocument.res56.Caption = exWb.Sheets("Reporting").Cells(70, 2)
ThisDocument.res57.Caption = exWb.Sheets("Reporting").Cells(71, 2)
ThisDocument.res58.Caption = exWb.Sheets("Reporting").Cells(72, 2)
ThisDocument.res59.Caption = exWb.Sheets("Reporting").Cells(73, 2)
ThisDocument.res60.Caption = exWb.Sheets("Reporting").Cells(74, 2)
ThisDocument.res61.Caption = exWb.Sheets("Reporting").Cells(75, 2)
ThisDocument.res62.Caption = exWb.Sheets("Reporting").Cells(76, 2)
ThisDocument.res63.Caption = exWb.Sheets("Reporting").Cells(77, 2)

exWb.Close

Set exWb = Nothing

End Sub

score 1 · Accepted Answer

下面的方法使用 GetOpenFilename 方法，它包括一些基本验证：

检查用户是否取消了文件对话窗口而不是选择文件。
检查所选文件是否确实是 XLSX 文件。
检查以确保所选文件中存在名为“报告”的所需工作表。
否则，退出子程序。

您可以添加更多文件过滤器或删除现有的过滤器，并对文件扩展名检查执行相同操作。您可以删除检查所需工作表的代码，或修改代码以检查其他所需工作表。

Private Sub Document_Open()
    Dim objExcel As New Excel.Application
    Dim exWb As Excel.Workbook
    Dim Filepath As Variant
    Dim ws As Excel.Worksheet
    Dim RequiredWorksheetsExist As Boolean

    Filepath = Application.GetOpenFilename(FileFilter:="Excel File (*.xlsx), *.xlsx", FilterIndex:=1, Title:="Open Excel File", MultiSelect:=False)
    ' Check if the user cancelled the open file dialog window.
    If (VarType(Filepath) <> VbVarType.vbString) Then GoTo ExitSub
    ' Check if the selected file has the expected file extension(s).
    If Not (Filepath Like "*.xlsx") Then GoTo ExitSub

    Set exWb = Application.Workbooks.Open(Filename:=Filepath)
    ' Check if expected worksheets exist in the selected file.
    For Each ws In exWb.Worksheets
        If (ws.Name = "Reporting") Then RequiredWorksheetsExist = True
    Next
    If Not (RequiredWorksheetsExist) Then GoTo ExitSub

    ThisDocument.number_name.Caption = exWb.Sheets("Reporting").Cells(4, 2)
    ThisDocument.Period.Caption = exWb.Sheets("Reporting").Cells(3, 2)

    ThisDocument.nr_persons.Caption = exWb.Sheets("Reporting").Cells(6, 2)
    ThisDocument.total_people.Caption = exWb.Sheets("Reporting").Cells(6, 3)
    ThisDocument.nr_subcontracts.Caption = exWb.Sheets("Reporting").Cells(7, 2)
    ThisDocument.thrid_party.Caption = exWb.Sheets("Reporting").Cells(8, 2)
    ThisDocument.travel_costs.Caption = exWb.Sheets("Reporting").Cells(9, 2)
    ThisDocument.depreciation.Caption = exWb.Sheets("Reporting").Cells(10, 2)
    ThisDocument.other_costs.Caption = exWb.Sheets("Reporting").Cells(11, 2)

    ThisDocument.res23sec.Caption = exWb.Sheets("Reporting").Cells(37, 3)
    ThisDocument.res29sec.Caption = exWb.Sheets("Reporting").Cells(43, 3)
    ThisDocument.res33sec.Caption = exWb.Sheets("Reporting").Cells(47, 3)
    ThisDocument.res33ter.Caption = exWb.Sheets("Reporting").Cells(47, 4)

    ThisDocument.res1.Caption = exWb.Sheets("Reporting").Cells(15, 2)
    ThisDocument.res2.Caption = exWb.Sheets("Reporting").Cells(16, 2)
    ThisDocument.res3.Caption = exWb.Sheets("Reporting").Cells(17, 2)
    ThisDocument.res4.Caption = exWb.Sheets("Reporting").Cells(18, 2)
    ThisDocument.res5.Caption = exWb.Sheets("Reporting").Cells(19, 2)
    ThisDocument.res6.Caption = exWb.Sheets("Reporting").Cells(20, 2)
    ThisDocument.res7.Caption = exWb.Sheets("Reporting").Cells(21, 2)
    ThisDocument.res8.Caption = exWb.Sheets("Reporting").Cells(22, 2)
    ThisDocument.res9.Caption = exWb.Sheets("Reporting").Cells(23, 2)
    ThisDocument.res10.Caption = exWb.Sheets("Reporting").Cells(24, 2)
    ThisDocument.res11.Caption = exWb.Sheets("Reporting").Cells(25, 2)
    ThisDocument.res12.Caption = exWb.Sheets("Reporting").Cells(26, 2)
    ThisDocument.res13.Caption = exWb.Sheets("Reporting").Cells(27, 2)
    ThisDocument.res14.Caption = exWb.Sheets("Reporting").Cells(28, 2)
    ThisDocument.res15.Caption = exWb.Sheets("Reporting").Cells(29, 2)
    ThisDocument.res16.Caption = exWb.Sheets("Reporting").Cells(30, 2)
    ThisDocument.res17.Caption = exWb.Sheets("Reporting").Cells(31, 2)
    ThisDocument.res18.Caption = exWb.Sheets("Reporting").Cells(32, 2)
    ThisDocument.res19.Caption = exWb.Sheets("Reporting").Cells(33, 2)
    ThisDocument.res20.Caption = exWb.Sheets("Reporting").Cells(34, 2)
    ThisDocument.res21.Caption = exWb.Sheets("Reporting").Cells(35, 2)
    ThisDocument.res22.Caption = exWb.Sheets("Reporting").Cells(36, 2)
    ThisDocument.res23.Caption = exWb.Sheets("Reporting").Cells(37, 2)
    ThisDocument.res24.Caption = exWb.Sheets("Reporting").Cells(38, 2)
    ThisDocument.res25.Caption = exWb.Sheets("Reporting").Cells(39, 2)
    ThisDocument.res26.Caption = exWb.Sheets("Reporting").Cells(40, 2)
    ThisDocument.res27.Caption = exWb.Sheets("Reporting").Cells(41, 2)
    ThisDocument.res28.Caption = exWb.Sheets("Reporting").Cells(42, 2)
    ThisDocument.res29.Caption = exWb.Sheets("Reporting").Cells(43, 2)
    ThisDocument.res30.Caption = exWb.Sheets("Reporting").Cells(44, 2)
    ThisDocument.res31.Caption = exWb.Sheets("Reporting").Cells(45, 2)
    ThisDocument.res32.Caption = exWb.Sheets("Reporting").Cells(46, 2)
    ThisDocument.res33.Caption = exWb.Sheets("Reporting").Cells(47, 2)
    ThisDocument.res34.Caption = exWb.Sheets("Reporting").Cells(48, 2)
    ThisDocument.res35.Caption = exWb.Sheets("Reporting").Cells(49, 2)
    ThisDocument.res36.Caption = exWb.Sheets("Reporting").Cells(50, 2)
    ThisDocument.res37.Caption = exWb.Sheets("Reporting").Cells(51, 2)
    ThisDocument.res38.Caption = exWb.Sheets("Reporting").Cells(52, 2)
    ThisDocument.res39.Caption = exWb.Sheets("Reporting").Cells(53, 2)
    ThisDocument.res40.Caption = exWb.Sheets("Reporting").Cells(54, 2)
    ThisDocument.res41.Caption = exWb.Sheets("Reporting").Cells(55, 2)
    ThisDocument.res42.Caption = exWb.Sheets("Reporting").Cells(56, 2)
    ThisDocument.res43.Caption = exWb.Sheets("Reporting").Cells(57, 2)
    ThisDocument.res44.Caption = exWb.Sheets("Reporting").Cells(58, 2)
    ThisDocument.res45.Caption = exWb.Sheets("Reporting").Cells(59, 2)
    ThisDocument.res46.Caption = exWb.Sheets("Reporting").Cells(60, 2)
    ThisDocument.res47.Caption = exWb.Sheets("Reporting").Cells(61, 2)
    ThisDocument.res48.Caption = exWb.Sheets("Reporting").Cells(62, 2)
    ThisDocument.res49.Caption = exWb.Sheets("Reporting").Cells(63, 2)
    ThisDocument.res50.Caption = exWb.Sheets("Reporting").Cells(64, 2)
    ThisDocument.res51.Caption = exWb.Sheets("Reporting").Cells(65, 2)
    ThisDocument.res52.Caption = exWb.Sheets("Reporting").Cells(66, 2)
    ThisDocument.res53.Caption = exWb.Sheets("Reporting").Cells(67, 2)
    ThisDocument.res54.Caption = exWb.Sheets("Reporting").Cells(68, 2)
    ThisDocument.res55.Caption = exWb.Sheets("Reporting").Cells(69, 2)
    ThisDocument.res56.Caption = exWb.Sheets("Reporting").Cells(70, 2)
    ThisDocument.res57.Caption = exWb.Sheets("Reporting").Cells(71, 2)
    ThisDocument.res58.Caption = exWb.Sheets("Reporting").Cells(72, 2)
    ThisDocument.res59.Caption = exWb.Sheets("Reporting").Cells(73, 2)
    ThisDocument.res60.Caption = exWb.Sheets("Reporting").Cells(74, 2)
    ThisDocument.res61.Caption = exWb.Sheets("Reporting").Cells(75, 2)
    ThisDocument.res62.Caption = exWb.Sheets("Reporting").Cells(76, 2)
    ThisDocument.res63.Caption = exWb.Sheets("Reporting").Cells(77, 2)

ExitSub:
    If Not (exWb Is Nothing) Then
        exWb.Close SaveChanges:=False
        Set exWb = Nothing
    End If
End Sub

score 0 · Accepted Answer

我在 fileDialog 属性上取得了成功。您也许可以在这里使用它：

Private Sub Document_Open()

Dim objExcel As New Excel.Application
Dim exWb As Excel.Workbook
Dim selectedItem as string

With Application.FileDialog(msoFileDialogOpen)
    .AllowMultiSelect = False
    .Show
 selecteditem = .SelectedItems(1)
 End With
'Workbooks.Open Filename:=selecteditem
Set exWb = objExcel.Workbooks.Open(selecteditem)

ThisDocument.number_name.Caption = exWb.Sheets("Reporting").Cells(4, 2)
ThisDocument.period.Caption = exWb.Sheets("Reporting").Cells(3, 2)

ThisDocument.nr_persons.Caption = exWb.Sheets("Reporting").Cells(6, 2)
ThisDocument.total_people.Caption = exWb.Sheets("Reporting").Cells(6, 3)
ThisDocument.nr_subcontracts.Caption = exWb.Sheets("Reporting").Cells(7, 2)
ThisDocument.thrid_party.Caption = exWb.Sheets("Reporting").Cells(8, 2)
ThisDocument.travel_costs.Caption = exWb.Sheets("Reporting").Cells(9, 2)
ThisDocument.depreciation.Caption = exWb.Sheets("Reporting").Cells(10, 2)
ThisDocument.other_costs.Caption = exWb.Sheets("Reporting").Cells(11, 2)

ThisDocument.res23sec.Caption = exWb.Sheets("Reporting").Cells(37, 3)
ThisDocument.res29sec.Caption = exWb.Sheets("Reporting").Cells(43, 3)
ThisDocument.res33sec.Caption = exWb.Sheets("Reporting").Cells(47, 3)
ThisDocument.res33ter.Caption = exWb.Sheets("Reporting").Cells(47, 4)

ThisDocument.res1.Caption = exWb.Sheets("Reporting").Cells(15, 2)
ThisDocument.res2.Caption = exWb.Sheets("Reporting").Cells(16, 2)
ThisDocument.res3.Caption = exWb.Sheets("Reporting").Cells(17, 2)
ThisDocument.res4.Caption = exWb.Sheets("Reporting").Cells(18, 2)
ThisDocument.res5.Caption = exWb.Sheets("Reporting").Cells(19, 2)
ThisDocument.res6.Caption = exWb.Sheets("Reporting").Cells(20, 2)
ThisDocument.res7.Caption = exWb.Sheets("Reporting").Cells(21, 2)
ThisDocument.res8.Caption = exWb.Sheets("Reporting").Cells(22, 2)
ThisDocument.res9.Caption = exWb.Sheets("Reporting").Cells(23, 2)
ThisDocument.res10.Caption = exWb.Sheets("Reporting").Cells(24, 2)
ThisDocument.res11.Caption = exWb.Sheets("Reporting").Cells(25, 2)
ThisDocument.res12.Caption = exWb.Sheets("Reporting").Cells(26, 2)
ThisDocument.res13.Caption = exWb.Sheets("Reporting").Cells(27, 2)
ThisDocument.res14.Caption = exWb.Sheets("Reporting").Cells(28, 2)
ThisDocument.res15.Caption = exWb.Sheets("Reporting").Cells(29, 2)
ThisDocument.res16.Caption = exWb.Sheets("Reporting").Cells(30, 2)
ThisDocument.res17.Caption = exWb.Sheets("Reporting").Cells(31, 2)
ThisDocument.res18.Caption = exWb.Sheets("Reporting").Cells(32, 2)
ThisDocument.res19.Caption = exWb.Sheets("Reporting").Cells(33, 2)
ThisDocument.res20.Caption = exWb.Sheets("Reporting").Cells(34, 2)
ThisDocument.res21.Caption = exWb.Sheets("Reporting").Cells(35, 2)
ThisDocument.res22.Caption = exWb.Sheets("Reporting").Cells(36, 2)
ThisDocument.res23.Caption = exWb.Sheets("Reporting").Cells(37, 2)
ThisDocument.res24.Caption = exWb.Sheets("Reporting").Cells(38, 2)
ThisDocument.res25.Caption = exWb.Sheets("Reporting").Cells(39, 2)
ThisDocument.res26.Caption = exWb.Sheets("Reporting").Cells(40, 2)
ThisDocument.res27.Caption = exWb.Sheets("Reporting").Cells(41, 2)
ThisDocument.res28.Caption = exWb.Sheets("Reporting").Cells(42, 2)
ThisDocument.res29.Caption = exWb.Sheets("Reporting").Cells(43, 2)
ThisDocument.res30.Caption = exWb.Sheets("Reporting").Cells(44, 2)
ThisDocument.res31.Caption = exWb.Sheets("Reporting").Cells(45, 2)
ThisDocument.res32.Caption = exWb.Sheets("Reporting").Cells(46, 2)
ThisDocument.res33.Caption = exWb.Sheets("Reporting").Cells(47, 2)
ThisDocument.res34.Caption = exWb.Sheets("Reporting").Cells(48, 2)
ThisDocument.res35.Caption = exWb.Sheets("Reporting").Cells(49, 2)
ThisDocument.res36.Caption = exWb.Sheets("Reporting").Cells(50, 2)
ThisDocument.res37.Caption = exWb.Sheets("Reporting").Cells(51, 2)
ThisDocument.res38.Caption = exWb.Sheets("Reporting").Cells(52, 2)
ThisDocument.res39.Caption = exWb.Sheets("Reporting").Cells(53, 2)
ThisDocument.res40.Caption = exWb.Sheets("Reporting").Cells(54, 2)
ThisDocument.res41.Caption = exWb.Sheets("Reporting").Cells(55, 2)
ThisDocument.res42.Caption = exWb.Sheets("Reporting").Cells(56, 2)
ThisDocument.res43.Caption = exWb.Sheets("Reporting").Cells(57, 2)
ThisDocument.res44.Caption = exWb.Sheets("Reporting").Cells(58, 2)
ThisDocument.res45.Caption = exWb.Sheets("Reporting").Cells(59, 2)
ThisDocument.res46.Caption = exWb.Sheets("Reporting").Cells(60, 2)
ThisDocument.res47.Caption = exWb.Sheets("Reporting").Cells(61, 2)
ThisDocument.res48.Caption = exWb.Sheets("Reporting").Cells(62, 2)
ThisDocument.res49.Caption = exWb.Sheets("Reporting").Cells(63, 2)
ThisDocument.res50.Caption = exWb.Sheets("Reporting").Cells(64, 2)
ThisDocument.res51.Caption = exWb.Sheets("Reporting").Cells(65, 2)
ThisDocument.res52.Caption = exWb.Sheets("Reporting").Cells(66, 2)
ThisDocument.res53.Caption = exWb.Sheets("Reporting").Cells(67, 2)
ThisDocument.res54.Caption = exWb.Sheets("Reporting").Cells(68, 2)
ThisDocument.res55.Caption = exWb.Sheets("Reporting").Cells(69, 2)
ThisDocument.res56.Caption = exWb.Sheets("Reporting").Cells(70, 2)
ThisDocument.res57.Caption = exWb.Sheets("Reporting").Cells(71, 2)
ThisDocument.res58.Caption = exWb.Sheets("Reporting").Cells(72, 2)
ThisDocument.res59.Caption = exWb.Sheets("Reporting").Cells(73, 2)
ThisDocument.res60.Caption = exWb.Sheets("Reporting").Cells(74, 2)
ThisDocument.res61.Caption = exWb.Sheets("Reporting").Cells(75, 2)
ThisDocument.res62.Caption = exWb.Sheets("Reporting").Cells(76, 2)
ThisDocument.res63.Caption = exWb.Sheets("Reporting").Cells(77, 2)

exWb.Close

Set exWb = Nothing

End Sub

excel - VBA提示“打开”对话框并选择要从中导入导入的目录

2 回答 2

Related

Reference