Как выполнить запрос из mysql в VBA?

Question

[Dato38it]

привет. я новичок в макросах.
Есть база данных mysql, excel из нее каким то образом берет и грузит данные. хочу попробовать написать свой макрос, который из sql выгружает какую-нибудь таблицу. база подключается, но я никак не могу найти информацию в картинках или на примерах, как мне загрузить из нее какие то данные? как пошагово это сделать?
Вот мой код:

Private Sub ConnectionDB()

    Dim oConn As Object
    Set oConn = New ADODB.Connection
    
    oConn.Open "DRIVER={MySQL ODBC 8.0 Unicode Driver};Server=tipwindows;Database=tabse;User=tuser;Password=tpassword;PORT:3306;Option=3"
   
    If oConn.State = adStateOpen Then
        MsgBox "Connected! =)"
    Else
        MsgBox "?an not connect... =("
    End If
    
    Dim cmd As ADODB.Command  'переменная в которой будет запрос
    Set cmd = New ADODB.Command
    
    Dim rec As ADODB.Recordset 'переменная в которой будет результат запроса
    Set rec = New ADODB.Recordset
    
    Set cmd.ActiveConnection = oConn
    cmd.CommandText = "SELECT * FROM bss_2g_nokia" 'собственно, запрос
    cmd.CommandType = adCmdText
    cmd.Execute
    
    Set rec.ActiveConnection = oConn
    rec.Open cmd
    
    oConn.Close
    
End Sub

при запуске такого кода выпадает ошибка:

Run-time error '-2147217865 (80040e37)'
Autpmation error

В питоне у меня все данные отображаются. просто начальство требует vba.

Answer 1

[Krasnoarmeec]

Баловался как-то с SQL в Экселе.
Скрипт создаёт TestDB.mdb. Кроме того там ещё парочка полезных функций. Как работает - уже не помню, но там имена говорящие сами за себя.

Сама табличка лежит тут:
https://disk.yandex.ru/i/qqjQRHnOMWJUPA

База данных тут:
https://disk.yandex.ru/d/-4CckpBkvwle8g

Код под спойлером

Option Explicit

Private Declare Function CoCreateGuid Lib "ole32" (pguid As GUID) As Long
Private Declare Function StringFromGUID2 Lib "ole32" (rguid As GUID, ByVal lpsz As Long, ByVal cchMax As Long) As Long

Private Type GUID
  Data1 As Long
  Data2 As Integer
  Data3 As Integer
  Data4(0 To 7) As Byte
End Type

Const DBname = "TestDB.mdb"

Sub CreateNewMdb()
    Dim Catalog As Object
    Set Catalog = CreateObject("ADOX.Catalog")
    Catalog.Create ("Provider=Microsoft.Jet.OLEDB.4.0;Jet OLEDB:Engine Type=5;Data Source=" & "D:\TMP\TestDB.mdb;")
End Sub

Sub CreateTblInDb()
    Dim adoConnection As ADODB.Connection
    Set adoConnection = New ADODB.Connection
    adoConnection.Open connectionString
    
    adoConnection.Execute ("CREATE TABLE tblDemoTable ([Product name] varchar(50), [Product ID] varchar(10), [Product Price] decimal)")
    adoConnection.Execute ("INSERT INTO tblDemoTable ([Product name], [Product ID], [Product Price]) VALUES ('Product one', '123', '3.45')")
End Sub

Sub GetRecords()
    Dim adoConnection As ADODB.Connection
    Dim SqlString$, connectionString$
    
    connectionString = "Provider=Microsoft.Jet.OLEDB.4.0;" & "Data Source=" & ExcelPath & "\" & DBname & ";"
    
    Set adoConnection = New ADODB.Connection
    adoConnection.Open connectionString
    adoConnection.Execute ("INSERT INTO tblDemoTable ([Product name], [Product ID], [Product Price]) VALUES ('Product two', '234', '3,45')")
    
    Dim rst As New ADODB.Recordset
    
    SqlString = "SELECT * FROM tblDemoTable;"
'    SqlString = "Select * From tblDemoTable WHERE 'Product ID' = '123';"
    rst.Open SqlString, adoConnection, adOpenForwardOnly, adLockReadOnly
    Dim x&, fld As ADODB.Field
    x = 0
    For Each fld In rst.Fields
        Cells(1, x + 1) = fld.Name
        x = x + 1
    Next fld
    
    Range("A2").CopyFromRecordset rst
    
    rst.Close
    Set rst = Nothing
    adoConnection.Close
    Set adoConnection = Nothing
    
    Dim guid1$
    guid1 = CreateGUID
End Sub

Sub Test()
    ListAccessTables (ExcelPath & "\" & DBname)
End Sub

Sub ListAccessTables(strDBPath)
    Dim cnnDB As ADODB.Connection
    Dim rstList As ADODB.Recordset
    
    Set cnnDB = New ADODB.Connection
    
    ' Open the connection.
    With cnnDB
        .Provider = "Microsoft.Jet.OLEDB.4.0"
        .Open strDBPath
    End With
    
    ' Open the tables schema rowset.
    Set rstList = cnnDB.OpenSchema(adSchemaTables)
    
    ' Loop through the results and print the
    ' names and types in the Immediate pane.
    With rstList
        Do While Not .EOF
            If .Fields("TABLE_TYPE") <> "VIEW" And .Fields("TABLE_TYPE") <> "SYSTEM TABLE" Then
                Debug.Print .Fields("TABLE_NAME")
            End If
            .MoveNext
        Loop
    End With
    
    cnnDB.Close
    Set cnnDB = Nothing
End Sub

Function ExcelPath()
    ExcelPath = Application.ActiveWorkbook.Path
End Function

Public Function CreateGUID() As String
  Dim NewGUID As GUID
  CoCreateGuid NewGUID
  CreateGUID = Space$(38)
  StringFromGUID2 NewGUID, StrPtr(CreateGUID), 39
  CreateGUID = Replace(Replace(CreateGUID, "}", ""), "{", "")
End Function

Comments

[Dato38it]

спасибо... я кстати нашел ошибку. тупо подключение с базой(

[Krasnoarmeec]

Рад, что всё получилось!
Спасибо, что отметили ответ как решение!

[Dato38it]

Krasnoarmeec, вам спасибо за источники. буду изучать, а то нигде не мог найти инфы нормальной

[Krasnoarmeec]

Да не за что. Там только исходники без указания источников.

Сам источник был на Ютюбе - десяток лекций по связыванию SQL с Экселем.
На деле первых двух хватило, чтобы сделать работающий прототип.

В печатном виде действительно почти ничего нет.
На ГитХабе тоже не густо - пара библиотек почти без описания.
Тем и славен ГитХаб - есть всё, но реально использовать можно только крохи.

Тиснуть статью на Хабр?

[Максим К]

Krasnoarmeec, да