MS Access Form按钮,允许用户浏览/选择文件excel,然后将文件导入表

时间:2017-05-29 12:53:05

标签: ms-access access-vba

在我的表单访问中,我想创建一个按钮来浏览/选择一个excel文件,并以访问中的表格格式导入它。

这是我的代码。

'需要引用Microsoft Office 15.0对象库。 “

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

1 个答案:

答案 0 :(得分:0)

有问题的代码是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