不使用TXT或CSV文件从Excel批量插入到SQLite

我有一个问题，我希望你们中的任何一位都能提供一些意见

基本上，我需要在VBA中编写一个代码，使我能够将excel中的数据表转换为sqlite

我已成功地使用以下代码完成此操作：

子脚本（）
对象为Dim objConnection，对象为objRecordset
将strDatabase设置为字符串
设置objConnection=CreateObject（“ADODB.Connection”）
strDatabase=“DRIVER={SQLite3-ODBC-DRIVER}；Database=“&Application.ActiveWorkbook.Path&”\TestDB.db；”
Query=“删除表基金；创建表基金（基金代码、基金名称、结束日期、主键（‘基金代码’）；”
里加=3
柱廊=1
而不是（IsNull（ActiveSheet.Cells（row，column.Value）或IsEmpty（ActiveSheet.Cells（row，column.Value））
Query=Query&“插入到基金值中（'”&单元格（行、列）&“，'”&单元格（行、列+1）&“，'”&单元格（行、列+2）&“；”
行=行+1
温德
对象连接。打开标准数据库
执行查询
对象连接。关闭
端接头

现在，我想用一种批量插入的方式来改变迭代部分，其中我说的是

row=row+1

，在这种方式中，程序获取整个表，而不是逐行执行

如果可能的话，我不想创建csv/txt文件

---

非常感谢，如果您有任何意见，我们将不胜感激。

一个非常基本的解决方案是，首先为批量插入构建完整的查询，然后一次性执行查询

例如—

插入基金价值（val1、val2）； 插入基金价值（val3、val4）

可替换为-

---

插入基金值（val1，val2），（val3，val4）

您可以将工作表.range中的所有数据附加到数组中（变量）

然后，使用数组中的数据，使用此模式构建SQL查询字符串

INSERT INTO table
(column1, column2, ... )
VALUES
(expression1, expression2, ... ),
(expression1, expression2, ... ),
...;

VBA函数（写在“膝盖上”，所以可能需要一些调整，抱歉）

使用数组而不是直接从工作表中获取数据的原因是：它的速度要快得多。您可以在此处阅读更多内容： 让我知道这是否适合你：）

---

编辑：
Ad1：你说得对，我们实际上不想转置它。然而，我已经习惯了这样写，因为在这篇主题的第7篇文章中详细描述了这样的原因：
Ad2：不，如果这是你的问题，它不一定要在函数中，但它使代码更干净，更可重用。您可以在下面找到内联解决方案：

Sub Scrivi()
Dim objConnection As Object, objRecordset As Object
Dim strDatabase As String, strQuery as String 

Set objConnection = CreateObject("ADODB.Connection")

strDatabase = "DRIVER={SQLite3 ODBC Driver};Database=" & Application.ActiveWorkbook.Path & "\TestDB.db;"

strQuery = "drop table FUND; create table FUND (Fund_Code, Fund_Name, End_Date, PRIMARY KEY('Fund_Code')); insert into FUND values"

'determine how many rows of data there is
Dim lastRow as Integer
lastRow = ActiveSheet.Range("A:A").Find("*", LookIn:=xlFormulas, SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row

'transfer all data from range to array
'range: from A3 to Cx, where x equals to lastRow
Dim arr as Variant
arr =

 ActiveSheet.Range("A3:C" & lastRow).Value

    'add all records from arr into single SQL query
    'Lbound(xArray, xDimension)/Ubound(xArray, xDimension) - returns integer equal to first/last xArray item in xDimension. Everyday-use function. Google some more to have better insight of whats going on
    Dim i as Integer
    For i=Lbound(arr,1) to Ubound(arr,1)
    strQuery = strQuery & "(" & arr(i,1) & "," & _
                                arr(i,2) & "," & _
                                arr(i,3) & "),"
Next i

'from the strQuery - swap last comma for semi-colon
strQuery = Left(strQuery, len(strQuery)-1) & ";"

objConnection.Open strDatabase
objConnection.Execute strQuery
objConnection.Close 

---

让我知道是否一切都清楚：）

谢谢你提供的信息。你是对的，但是如果我决定创建另一行呢？然后我必须再次修改代码！我想用一个更有效、更省时的代码来消除“whilenot”这句话。谢谢你的输入！这是我第一次使用VBA做更多的事情（创建连接等）。所以我有点困惑。我有一些问题：1）为什么要使用application.transpose？我不想要一个转置矩阵2）这个函数是代码运行的基础，对吗？我想是的，但我想确认一下，再次感谢；）注释代码太多，所以我不得不编辑。随便问你会想到的任何问题好的，一切似乎都很清楚。只有一件事：为什么这部分代码？“'从strQuery-将最后一个逗号替换为分号strQuery=Left（strQuery，len（strQuery）-1）&”；“”@StevenIngo抱歉耽搁了。strQuery退出For循环后，它的末尾将有逗号（“，”），但是SQL语法要求您在末尾放分号（；”）。因此，我们希望将字符串整串减去最后一个字符：

Left（strQuery，len（strQuery）-1）

，其中

len（strQuery）-1

返回字符串长度减去1，而

Left（str，len（str）-1）

提供整个字符串减去最后一个字符。然后，我们只需通过在末尾键入

&“

来添加分号

Function buildQueryFromArray(arr as Variant, table as String, columns as String) as String
    Dim strSqlQuery as String * 4096 
    Dim i as Integer

    strSqlQuery = "INSERT INTO " & table & " (" & columns & ") VALUES"
    For i=LBound(arr, 1) to UBound(arr, 1)
        strSqlQuery = strSqlQuery & "(" & arr(i,1) & ", " & arr(i,2) & "etc" & "),"
    Next i
    buildQueryFromArray = Left(strSqlQuery, len(strSqlQuery)-1) & ";"
End Function

Sub Scrivi()
Dim objConnection As Object, objRecordset As Object
Dim strDatabase As String, strQuery as String 

Set objConnection = CreateObject("ADODB.Connection")

strDatabase = "DRIVER={SQLite3 ODBC Driver};Database=" & Application.ActiveWorkbook.Path & "\TestDB.db;"

strQuery = "drop table FUND; create table FUND (Fund_Code, Fund_Name, End_Date, PRIMARY KEY('Fund_Code')); insert into FUND values"

'determine how many rows of data there is
Dim lastRow as Integer
lastRow = ActiveSheet.Range("A:A").Find("*", LookIn:=xlFormulas, SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row

'transfer all data from range to array
'range: from A3 to Cx, where x equals to lastRow
Dim arr as Variant
arr =

 ActiveSheet.Range("A3:C" & lastRow).Value

    'add all records from arr into single SQL query
    'Lbound(xArray, xDimension)/Ubound(xArray, xDimension) - returns integer equal to first/last xArray item in xDimension. Everyday-use function. Google some more to have better insight of whats going on
    Dim i as Integer
    For i=Lbound(arr,1) to Ubound(arr,1)
    strQuery = strQuery & "(" & arr(i,1) & "," & _
                                arr(i,2) & "," & _
                                arr(i,3) & "),"
Next i

'from the strQuery - swap last comma for semi-colon
strQuery = Left(strQuery, len(strQuery)-1) & ";"

objConnection.Open strDatabase
objConnection.Execute strQuery
objConnection.Close