插入 Access 从 Access VBA 中的 Excel 中选择

Fre*_*Man 5 ms-access vba ms-access-2010 excel-2010

我有一个 Access 2010 数据库,其中所有表都链接到 SQL Server 2014 表。我有一个 Excel 2010 (.xlsx) 文件(尽管它以 .csv 开头,我可以保留这种方式),我需要通过 VBA 代码将其导入到 SQL Server 表中。我知道有导入工具可以执行此操作,但是,我每月有 20 多个 XLS 文件需要导入,并且更希望有一种自动化方法来执行此操作。

我的所有 VBA 代码都驻留在 Access 数据库中,并且我能够找到的所有 VBA 代码示例都是用于从 Excel推送数据(即代码位于 Excel 中)而不是提取数据(即代码在Access中) 。

我更愿意用一个来完成INSERT INTO AccessTable SELECT FROM ExcelRange查询来完成此操作,而不是逐行读取 Excel,并且我需要在插入 Excel 数据之前对其进行一些转换。

到目前为止我所拥有的:

Private Sub TransferData(ByVal Company As String, ByVal Address As String, ByVal XLName As String)

Dim Con As ADODB.Connection
Dim SQLString As String

  SQLString = "INSERT INTO SatSurvey " & _
              "(ClinicID, Method, CollectionDate, Duration, Q1, Q2, Q3, Q4, Q5, Q6, Q7, Q8, Q10, Q11, Q12, Q13, Q14, Q15, Q16, Q17, Q18, Q19, Q20, Q21, Q22, Physician, Nurse, MedAst) " & _
              "SELECT " & _
              "('clinic name', IDFormat, IDendDate, IDtime, Q1, Q2, Q3, Q4, Q5, Q6, Q7, Q8, Q10, Q11, Q12, Q13, Q14, Q15, Q16, Q17, Q18, Q19, Q20, Q21, Q22, NZ(Q9s1,1), NZ(Q9s2,1), NZ(Q9s3,1)) " & _
              "  FROM [Excel 12.0;HDR=Yes;Database=" & XLName & "]." & Address

  Set Con = New ADODB.Connection
'  Con.ConnectionString = "Datasource=" & CurrentProject.Connection
  Con.ConnectionString = CurrentProject.Connection

'  Con.Properties(9).Value = "Extended Properties='Excel 12.0 Xml;HDR=YES';"
'  Con.Provider = "Microsoft.ACE.OLEDB.12.0;Extended Properties='Excel 12.0 Xml;HDR=YES';"

  Con.Open

  Con.Execute SQLString

End Sub
Run Code Online (Sandbox Code Playgroud)

正如您所看到的,我尝试了几种不同的选项来使事情正常进行。这似乎效果最好,除了我现在得到的:

运行时错误“-2147467259 (80004005)”:
计算机“MINIT-EGHJSAU”上的用户“Admin”已将数据库置于阻止其打开或锁定的状态。

显示的机器名称是我的机器。由于代码是从我的计算机上的 Access 中运行的,因此我打开数据库似乎是合乎逻辑的。

我并不一定要这样做,所以欢迎任何修复或替代建议。

Han*_*sUp 6

您不需要创建一个New ADODB.Connection连接到当前在 Access 会话中打开的数据库的连接。您的Con对象变量可以简单地引用CurrentProject.Connection...

Set Con = CurrentProject.Connection
Run Code Online (Sandbox Code Playgroud)

但是,您实际上甚至不需要该对象变量。Execute只需直接使用CurrentProject.Connection...的方法

CurrentProject.Connection.Execute SQLString
Run Code Online (Sandbox Code Playgroud)

这比你现在所拥有的更简单,但我不确定它会消除“状态......阻止它被打开或锁定”投诉。

既然您说“欢迎其他建议”,请考虑使用 DAO 而不是 ADO。并且不要在查询SELECT片段中的字段表达式列表两边包含括号INSERT(无论您选择 ADO 还是 DAO)。

Private Sub TransferData(ByVal Company As String, ByVal Address As String, ByVal XLName As String)
    Dim SQLString As String

    SQLString = "INSERT INTO SatSurvey " & _
                "(ClinicID, Method) " & _
                "SELECT '<location>', IDFormat " & _
                " FROM [Excel 12.0;HDR=Yes;Database=" & XLName & "]." & Address
    Debug.Print SQLString
    CurrentDb.Execute SQLString, dbFailOnError
End Sub
Run Code Online (Sandbox Code Playgroud)