时间戳

首页 > 解决方案 > 如何将 Excel 文件导入 Microsoft Access 2013

sql - 如何将 Excel 文件导入 Microsoft Access 2013

问题描述

我有一个 Access 2013 数据库，其中所有表都链接到 SQL Server 2016 表。我有一个 Excel 2013 (.xlsx) 文件，我需要将它导入到 Ms Access 中的一个表中，该表通过 vba 代码链接到 SQL Server（xlsx 和表中的所有字段都是相同的）

我所有的 VBA 代码都驻留在 Access 数据库中，我有一个带有事件按钮的表单，我尝试使用 de“transferspreadsheet”，一个用于 sql 的“插入到”子句，但它们都不适合我

这是我的代码，

xtRuta2 表单中具有路径的字段名称 Dim strArchivo2 String ' 文件路径 xlsx c:\reports\mireporte.xlsx dim miAlerta2 as string Dim ssql As String

strArchivo2 = txtRuta2

miAlerta2 = MsgBox("¿您要为“ & strArchivo2 & "导入新信息吗？" & vbCrLf & vbCrLf & "此操作将更新所有信息", vbExclamation + vbOKCancel, "¡INFORMATION IMPORT ALERT!")

If miAlerta2 = vbOK Then varAlert2 = MsgBox("请确认您要导入新信息？", vbExclamation + vbOKCancel, "¡CONFIRMATION IMPORT ALERT!") If varAlert2 = vbOK Then

      'DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel12, "tbl_ZSales_Export Worksheet", strArchivo2, True, "Export Worksheet$"

            ssql = "INSERT INTO [tbl_Export Worksheet] select * FROM OPENROWSET('Microsoft.ACE.OLEDB.12.0', 'Excel 12.0;Database=" & strArchivo2 & ";HDR=YES', 'SELECT * FROM [Export Worksheet$)'"

            'CurrentDb.Execute ssql

    MsgBox "Import Finished", vbExclamation + vbOKOnly

endif 结束如果

你能帮我写下正确的代码吗？

感谢和问候！

标签： sqlvbams-accessms-access-2013

解决方案

这段代码（与 excel 的后期交互）用于将 excel 表转换为文本文件，然后导入到您选择的表中。我更喜欢使用这种方法，因为访问有一个令人讨厌的习惯，即在使用传输电子表格时尝试为您解释您的数据。通过创建导入规范（使用此方法需要这样做），您可以轻松地预定义数据类型。

Option Compare Database
Option Explicit

Private Sub stuff()
    On Error GoTo GetAccrualFile_Err
    Dim fileLoc As String
    Dim path As String, Sep As String, NewTextFile As String, WholeLine As String
    Dim oXL As Object, sheet As Object
    Dim i As Long, j As Long, counteri As Long, counterj As Long
    Dim bringOver As Variant
    DoCmd.SetWarnings False
    DoCmd.Hourglass True
    counteri = 0
    counterj = 0
    Sep ="your prefered delimiter"
    DoCmd.RunSQL "DELETE * FROM TBL"
    fileLoc = "UNC PATH AND FILE NAME" & ".xlsx"
    path = Left(fileLoc, InStrRev(fileLoc, "\") - 1) & "\"
    NewTextFile = "UNC PATH AND FILE NAME" & ".txt"
    Set oXL = CreateObject("Excel.Application")
    With oXL
        .WorkBooks.Open FileName:=path & Dir$(fileLoc)
        Open NewTextFile For Output As #2
        bringOver = .Worksheets("your sheet name").UsedRange  'you might need to adjust this line to get the sheet your after
        For i = LBound(bringOver, 1) To UBound(bringOver, 1)
            For j = LBound(bringOver, 2) To UBound(bringOver, 2)
                WholeLine = WholeLine & bringOver(i, j) & Sep
                counterj = counterj + 1
            Next j
            'used if you want to skip column headers
            If counteri <> 0 Then
                Print #2, WholeLine
            End If
            WholeLine = ""
            counteri = counteri + 1
            counterj = 0
        Next i
        counteri = 0
        Erase bringOver
    End With    
    Close #2
    DoCmd.TransferText acImportDelim, "importspecname", "tbltoimportto", NewTextFile, False
    '***************************************************************************************
    'you will need to learn how to set up import specs, as well as understand the arguments for DoCmd.TransferText  
    '***************************************************************************************
CleanUp:
    DoCmd.SetWarnings True
    DoCmd.Hourglass False
    On Error Resume Next
    DoEvents
    oXL.Quit
    oXL.Application.Quit
    If Dir(NewTextFile) <> "" Then Kill NewTextFile
    Erase bringOver
    DoCmd.SetWarnings True
    DoCmd.Hourglass False
    Exit Sub
GetAccrualFile_Err:
    DoCmd.SetWarnings True
    DoCmd.Hourglass False
    msgbox "An error has occured.  " & " " & ERR.Number & " " & ERR.Description & " "
    GoTo CleanUp
    Resume
End Sub

推荐阅读