如何在 VBA for Excel 中创建针对 SQLite 数据库的查询并检索数据？

感谢@Akina的回答，结果是下面的代码，它可能不是很好，但它从SQLite数据库插入数据。你可以继续前进

Sub GetCadastralInfo()
    Dim dbPath As String
    Dim cadNumber As String
    Dim conn As Object
    Dim rs As Object
    Dim sql As String

    On Error GoTo ErrorHandler

    dbPath = "C:\my_python\Bot_aio\akt\egrn_v.db"
    
    cadNumber = Trim(ActiveCell.Value)

    Set conn = CreateObject("ADODB.Connection")
    Set rs = CreateObject("ADODB.Recordset")

    conn.Open "Driver={SQLite3 ODBC Driver};Database=" & dbPath & ";"
    
    sql = "SELECT by_document FROM Information_objects WHERE cad_numb = '" & cadNumber & "';"
    Set rs = conn.Execute(sql)
    

    If Not rs.EOF Then
        rs.MoveFirst ' Установить указатель на первую запись
        
        ' Цикл для перебора записей
        Do While Not rs.EOF
            Range("B1").Value = rs.Fields(0).Value
            rs.MoveNext ' Перейти к следующей записей
        Loop
    Else
        MsgBox "Нет данных для данного кадастрового номера.", vbInformation
    End If
    
    rs.Close
    conn.Close

    Exit Sub

ErrorHandler:
    Debug.Print Err.Description

    If Not rs Is Nothing Then
        If rs.State = 1 Then rs.Close ' Закрыть, если открыто
    End If
    If Not conn Is Nothing Then
        If conn.State = 1 Then conn.Close ' Закрыть, если открыто
    End If
End Sub

Function ПоискВБазе(КадастровыйНомер As String, НаименованиеШапкиТаблицы As String) As Variant
    Dim dbPath As String
    Dim conn As Object
    Dim rs As Object
    Dim sql As String
    Dim resultValue As Variant
    Dim dateList As Collection
    Dim dateStr As String
    Dim currentDate As Date
    Dim maxDate As Date
    Dim maxDateStr As String
    Dim i As Integer

    On Error GoTo ErrorHandler
    dbPath = "C:\my_python\Bot_aio\akt\egrn_v.db"
    КадастровыйНомер = Trim(КадастровыйНомер)
    Set conn = CreateObject("ADODB.Connection")
    Set rs = CreateObject("ADODB.Recordset")
    conn.Open "Driver={SQLite3 ODBC Driver};Database=" & dbPath & ";"
    
    ' Получение всех дат
    sql = "SELECT date_formation FROM Information_objects WHERE cad_numb = '" & КадастровыйНомер & "';"
    Set rs = conn.Execute(sql)
    
    Set dateList = New Collection
    If Not rs.EOF Then
        Do While Not rs.EOF
            dateStr = rs.Fields("date_formation").Value
            On Error Resume Next
            currentDate = CDate(dateStr)
            If Err.Number = 0 Then
                dateList.Add currentDate
            End If
            On Error GoTo ErrorHandler
            rs.MoveNext
        Loop
        
        ' Найти максимальную дату
        If dateList.Count > 0 Then
            maxDate = dateList(1)
            For i = 2 To dateList.Count
                If dateList(i) > maxDate Then
                    maxDate = dateList(i)
                End If
            Next i

            maxDateStr = Format(maxDate, "dd.mm.yyyy")
        End If
    End If
    
    sql = "SELECT " & НаименованиеШапкиТаблицы & " FROM Information_objects WHERE cad_numb = '" & КадастровыйНомер & "' AND date_formation = '" & maxDateStr & "';"
    
    ' Выполнение запроса и получение результата
    Set rs = conn.Execute(sql)
    If Not rs.EOF Then
        resultValue = rs.Fields(0).Value
        
        ' Замена точек на запятые для указанных столбцов
        If НаименованиеШапкиТаблицы = "cost_value" Or _
           НаименованиеШапкиТаблицы = "area" Or _
           НаименованиеШапкиТаблицы = "built_up_area" Or _
           НаименованиеШапкиТаблицы = "extension" Or _
           НаименованиеШапкиТаблицы = "depth" Or _
           НаименованиеШапкиТаблицы = "occurence_depth" Or _
           НаименованиеШапкиТаблицы = "volume" Or _
           НаименованиеШапкиТаблицы = "height" Or _
           НаименованиеШапкиТаблицы = "degree_readiness" Then
            
            If Not IsNull(resultValue) Then
                Dim formattedValue As String
                formattedValue = Replace(resultValue, ".", ",")
                
                If НаименованиеШапкиТаблицы = "cost_value" Then
                    ПоискВБазе = formattedValue
                Else
                    ПоискВБазе = formattedValue ' Возвращаем отформатированное значение для других столбцов
                End If
                
            Else
                ПоискВБазе = ""
            End If
            
        Else
            If IsNull(resultValue) Or resultValue = 0 Then
                ПоискВБазе = ""
            Else
                ПоискВБазе = resultValue
            End If
        End If
        
    Else
        ПоискВБазе = ""
    End If

Cleanup:
    On Error Resume Next ' Игнорируем ошибки при закрытии объектов
    If Not rs Is Nothing Then If rs.State = 1 Then rs.Close ' Закрываем набор записей, если он открыт
    If Not conn Is Nothing Then If conn.State = 1 Then conn.Close ' Закрываем соединение, если оно открыто
    
    Exit Function

ErrorHandler:
    ПоискВБазе = "Ошибка: " & Err.Description
    Resume Cleanup

End Function

结果在最终版本中是这样的，它似乎有效......也许写得很笨拙......@Akina抱歉，我不明白......我做了上面的rs.MoveFirst（在原始代码中，不是我发布的），而是代码为什么它不起作用，我挣扎了很长时间，我的头疼得要命））））最后我做了一张表格，写下了列的名称从数据库中将其发送到此处sql = "SELECT " & НаименованиеШапкиТаблицы & " FROM Information_objects WHERE cad_numb = '" & КадастровыйНомер & "' AND date_formation = '" & maxDateStr & "';"搜索当前信息所需的最大日期（日期） 。摘自国家统一房地产登记册）