MS Access表單按鈕，允許用戶瀏覽/選擇文件excel，然後將文件導入到表格

Question

在我的表單訪問中，我想創建一個按鈕來瀏覽/選擇一個excel文件並以格式導入一個表格。

這是我的代碼。

'需要參考Microsoft Office 15.0 Object Library。 '

Public Function ImportDocument() As TaskImportEnum 
On Error GoTo ErrProc 

Dim fd As FileDialog 
Set fd = Application.FileDialog(msoFileDialogFilePicker) 

With fd 
    .InitialFileName = "Some folder" 
    .Title = "Dialog Title" 
    With .Filters 
     .Clear 
     .Add "xlsx documents", "*.xlsx", 1 
    End With 
    .ButtonName = " Import Selected " 
    .AllowMultiSelect = False 'Change this to TRUE to enable multi-select 

    'If aborted, the Function will return the default value of Aborted 
    If .Show = 0 Then GoTo Leave 
End With 

Dim selectedItem As Variant 
For Each selectedItem In fd.SelectedItems 
    DoCmd.TransferText acImportDelim, "Raw Data from Import_ Import Specification", "Raw Data from Import", selectedItem, True, "" 
Next selectedItem 

ImportDocument = TaskImportEnum.Success 

Leave: 
Set fd = Nothing 
On Error GoTo 0 
Exit Function 

ErrProc: 
MsgBox err.Description, vbCritical 
ImportDocument = TaskImportEnum.Failure 'Return Failure if error 
Resume Leave 
End Function 

Answer 1

有問題的代碼是提供的解決方案的一部分here。但是，由於提供的解決方案涉及CSV文件導入，因此需要進行一些更改。

---

在一個標準模塊，粘貼如下：

Public Enum TaskImportEnum 
    Aborted = 0 'default 
    Success 
    Failure 
End Enum 

Public Function ImportDocument() As TaskImportEnum 
    On Error GoTo ErrProc 

    Dim fd As FileDialog 
    Set fd = Application.FileDialog(msoFileDialogFilePicker) 

    With fd 
     .InitialFileName = "Some folder" 
     .Title = "Dialog Title" 
     With .Filters 
      .Clear 
      .Add "Excel documents", "*.xlsx", 1 
     End With 
     .ButtonName = " Import Selected " 
     .AllowMultiSelect = False 'Change this to TRUE to enable multi-select 

     'If aborted, the Function will return the default value of Aborted 
     If .Show = 0 Then GoTo Leave 
    End With 

    Dim selectedItem As Variant 
    For Each selectedItem In fd.SelectedItems 
     DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel12Xml, "YourTableName", selectedItem, True, "YourSheetName$" 'Change 'YourTableName' and 'YourSheetName' to the actual names 
    Next selectedItem 

    'Return Success 
    ImportDocument = TaskImportEnum.Success 

Leave: 
    Set fd = Nothing 
    On Error GoTo 0 
    Exit Function 

ErrProc: 
    MsgBox Err.Description, vbCritical 
    ImportDocument = TaskImportEnum.Failure 'Return Failure if error 
    Resume Leave 
End Function 

---

在您的按鈕的Click事件粘貼如下：

Dim status_ As TaskImportEnum 
    status_ = ImportDocument 

Select Case status_ 
    Case TaskImportEnum.Success: 
     MsgBox "Success!" 

    Case TaskImportEnum.Failure: 
     MsgBox "Failure..." 

    Case Else: 
     MsgBox "Aborted..." 
End Select