SELECT * FROM Vzakladke.net

Статьи об автоматизации и программировании

MS Access VBA и MySQL подключение

 

 

Для автоматизации получения данных из сайта в файл Excel прямо из MS Office можно настроить учетную запись в PHPmyAdmin, предоставив разрешение для внешнего доступа.

Соединение с базой данных MySQL осуществим через MS Access на VBA предварительно установив ODBC драйвер для MySQL и настроив DSN - соединение в ODBC настройках.

 

В самом начале как обычно пишем:

Option Compare Database 'сортировка символов определяется базой данных
Option Explicit 'запретить не объявленные переменные
 

Объявляем переменные в шапке самой формы, которые обязательно нам понадобятся.

Dim con As New ADODB.Connection
Dim rs As New ADODB.Recordset 'объект набора данных

Dim i As Integer, j As Integer 'счетчики
Dim DA 'динамический массив для вывода данных
Const Шаблон As String = "\Шаблоны\Справка.xlt" 'относительный путь к шаблону
Dim sq As String
Dim b As Boolean

 

Как видно из объявления переменных, мы указали на создание шаблона в который мы будет помещать ответ от сервера.

Заполняем листбокс перечнем таблиц из базы данных при загрузке формы

Private Sub Form_Load()
con.ConnectionString = "DSN=asksql.org;SERVER=asksql.org;UID=login;PORT=3306"
con.Open
Set rs = New ADODB.Recordset
sq = "SHOW FULL TABLES IN   `db_name` "
With rs
.ActiveConnection = con
.CursorType = adOpenDynamic
.CursorLocation = adUseClient
.Open sq
End With
' Combo1.RowSourceType = query
rs.MoveFirst
While Not rs.EOF
List5.AddItem (rs(0))
' Combo1.AddItem (rs(0))
' Combo1.RowSource = rs("Tables_in_db_name")
' MsgBox rs("Tables_in_db_name")
rs.MoveNext
Wend
'   Application.DoCmd.OpenQuery " select * from db_name.vote_track"     
End Sub

 

Строку соединения можно написать напрямую  - не создавая  настроек DSN соединения в ODBC настройках.

Const ServerName As String = "asksql.org"
Const User_ID  As String = "rgrgr"
Const Database_Name As String = "rgrgr"
Const Password  As String = "gfgf"
Const MySQL_ConnectString = "Driver={MySQL ODBC 5.2 ANSI Driver};Server=" & ServerName & ";Database=" & Database_Name & _
    ";Uid=" & User_ID & ";Pwd=" & Password & ";"

 

Это еще не все... нужно выгрузить данные в Excel, для этого пусть будущую процедуру назовем например new1 и создадим для нее кнопку на форме:

Private Sub ButtonExport_Click()
 new1 (List5.Value)
End Sub

 

Опишем модуль вывода в Excel:

'модуль формирования сводной таблицы по проекту
Option Compare Database 'сортировка символов определяется базой данных
Option Explicit 'запретить не объявленные переменные

Dim cnn As New ADODB.Connection
Const MySQLConnectString = "DSN=asksql.org;SERVER=asksql.org;UID=login;PORT=3306"
Dim rs As New ADODB.Recordset 'объект набора данных
Dim cmd As ADODB.Command

Dim EA As Excel.Application 'объект приложения Excel
Dim i As Integer, j, MyVal As Integer 'счетчики
Dim DA 'динамический массив для вывода данных
Const Шаблон As String = "\Справка.xlt" 'относительный путь к шаблону
Dim sq, Представление As String
 
    
Sub new1(Представление As String)
On Error Resume Next
    Set EA = CreateObject("Excel.Application") 'запускаем Excel
    EA.Workbooks.Add Template:=Application.CurrentProject.Path & Шаблон 'открываем шаблон
    EA.Cells.Select 'выделить все
    EA.Selection.Clear 'очистить
    EA.Selection.NumberFormat = "0;-0;;@" ' формат: 0 - не показывать    'EA.Selection.NumberFormat = "@"
    
    
Set cmd = New ADODB.Command
With cmd
.CommandTimeout = 60
End With

cnn.ConnectionString = "DSN=asksql.org;SERVER=asksql.org;UID=login;PORT=3306"
cnn.Open

sq = "SELECT * FROM tablename." & Представление
 
With rs
.ActiveConnection = cnn
.CursorType = adOpenDynamic
.CursorLocation = adUseClient
.Open sq
End With

'rs.Open Представление, CurrentProject.Connection, adOpenKeyset, adLockOptimistic, adCmdText
    
    ReDim DA(0 To 0, 0 To rs.Fields.Count - 1) 'выделяем память для заголовка таблицы
    For j = 0 To rs.Fields.Count - 1 'перебираем все поля функции
        DA(0, j) = rs.Fields(j).Name 'заносим имена полей в массив
    Next j
    EA.Range(EA.ActiveCell.Offset(0, 0), EA.ActiveCell.Offset(0, rs.Fields.Count - 1)).Formula = DA 'выводим шапку таблицы
    Erase DA 'очищаем массив, освобождаем память
    
    rs.MoveLast 'переходим в конец для подсчёта количества строк в наборе данных
    ReDim DA(0 To rs.RecordCount - 1, 0 To rs.Fields.Count - 1) 'выделяем память для данных таблицы
    rs.MoveFirst 'возвращаемся в начало
    i = 0 'инициализируем счётчик строк
    Do While Not rs.EOF ' перебираем строки
        For j = 0 To rs.Fields.Count - 1 'перебираем поля
            DA(i, j) = rs(j) 'заносим данные в массив
        Next j
        rs.MoveNext 'читаем следующую строку набора данных
        i = i + 1 ' увеличить порядковый номер
    Loop
    'выводим массив в таблицу
    EA.Range(EA.ActiveCell.Offset(1, 0), EA.ActiveCell.Offset(rs.RecordCount, rs.Fields.Count - 1)).Formula = DA

    'выводим массив в таблицу
    EA.Range(EA.ActiveCell.Offset(1, 0), EA.ActiveCell.Offset(rs.RecordCount, rs.Fields.Count - 1)).Formula = DA
        'формат шапки таблицы
    EA.Range(EA.ActiveCell.Offset(0, 0), EA.ActiveCell.Offset(0, rs.Fields.Count - 1)).ColumnWidth = 10 'ширина всех колонок
    EA.Columns("A:A").ColumnWidth = 21 'ширина 1-ой колонки
    EA.Range(EA.ActiveCell.Offset(0, 0), EA.ActiveCell.Offset(0, rs.Fields.Count - 1)).Font.Name = "Times New Roman"  'устанавливаем шрифт
    EA.Range(EA.ActiveCell.Offset(0, 0), EA.ActiveCell.Offset(0, rs.Fields.Count - 1)).Font.Size = 10  'устанавливаем размер шрифта
    EA.Range(EA.ActiveCell.Offset(0, 0), EA.ActiveCell.Offset(0, rs.Fields.Count - 1)).Font.FontStyle = "Bold"
    EA.Range(EA.ActiveCell.Offset(0, 0), EA.ActiveCell.Offset(0, rs.Fields.Count - 1)).WrapText = True 'перенос текста
    EA.Range(EA.ActiveCell.Offset(0, 0), EA.ActiveCell.Offset(0, rs.Fields.Count - 1)).VerticalAlignment = xlTop 'выравнивание по высоте - верх
    'обрисуем границы
    EA.Range(EA.ActiveCell.Offset(i, rs.Fields.Count - 1), EA.ActiveCell.Offset(0, 0)).Borders(xlEdgeTop).Weight = xlThin  'подчёркиваем строку
    EA.Range(EA.ActiveCell.Offset(i, 0), EA.ActiveCell.Offset(0, 0)).Borders(xlEdgeBottom).Weight = xlThin  'подчёркиваем строку
    EA.Range(EA.ActiveCell, EA.ActiveCell.Offset(i, rs.Fields.Count)).Borders(xlInsideVertical).Weight = xlThin   ' чертим внутреннюю вертикаль
    EA.Range(EA.ActiveCell, EA.ActiveCell.Offset(i, rs.Fields.Count - 1)).Borders(xlEdgeLeft).Weight = xlThin  ' чертится линия слева
    EA.Range(EA.ActiveCell, EA.ActiveCell.Offset(i, rs.Fields.Count - 1)).Borders(xlInsideHorizontal).Weight = xlThin  ' чертим внутреннюю горизонталь
    EA.Range(EA.ActiveCell.Offset(i, 0), EA.ActiveCell.Offset(0, rs.Fields.Count - 1)).Borders(xlEdgeBottom).Weight = xlThin  'подчёркиваем строку
    
     EA.Cells.Select 'выделить все
     EA.Selection.Columns.AutoFit
     EA.Columns("D:D").ColumnWidth = 10
    
    'зафиксировать панель
    ' EA.Rows("1:1").Select
    ' EA.ActiveWindow.FreezePanes = True
    
    'сохраняем документ
    EA.ActiveWorkbook.SaveAs Application.CurrentProject.Path & "\" & Year(Date) & "-" & Month(Date) & "-" & Day(Date) & "_" & "_справка", xlExcel8, , , , , , True
    
    EA.Visible = True 'делаем Excel видимым
    Set EA = Nothing 'очищаем переменную и отключаемся от Excel
' --
    rs.Close 'закрываем набор данных
    Set rs = Nothing 'освобождаем память

  
'Set prm = Nothing
Set cmd = Nothing
'cnn.Close
Set cnn = Nothing
End Sub

 

 

На этом тоже не все... Давайте рассмотрим пример наполнения комбобокса:

Private Sub Кнопка0_Click()
Dim ConnectionMySQL As New ADODB.Connection
Const MySQL_ConnectString = "DSN=asksql.org;SERVER=asksql.org;UID=db_name_1;PORT=3306"
Dim RecordsetMySQL As New ADODB.Recordset 'объект набора данных
 
Set ConnectionMySQL = CreateObject("ADODB.Connection") ' Create connection object
ConnectionMySQL.CursorLocation = 2 ' Use client type cursor
ConnectionMySQL.Open MySQL_ConnectString, "", "", -1 ' Connect to the database

Set RecordsetMySQL = CreateObject("ADODB.Recordset")
RecordsetMySQL.Open "SHOW FULL TABLES IN   `db_name_1`", ConnectionMySQL, 2, 3, 1
Do While Not RecordsetMySQL.EOF ' Do Until RecordsetMySQL.EOF
' WScript.Echo RecordsetMySQL.Fields(0)
' MsgBox RecordsetMySQL.Fields(0)
  Combo1.AddItem RecordsetMySQL!Tables_in_db_name_1
 RecordsetMySQL.MoveNext
Loop
 
RecordsetMySQL.Close
ConnectionMySQL.Close
End Sub

 

 

 

Дата публикации: 2015-06-22 09:16:49

MySQL, MS Access, VBA

1

Отзывы:

Ваня
Дополним к этой теме, вдруг понадобится применять форматы данных в Excel: " "# ##0_\(00,0%) - такой формат в скобках выведет в вашем шаблоне проценты в скобках (применяется для диаграмм) [>1000]#,0 " тыс.";#,0;# ##0,00 или [>1000]#,0 " тыс.";;# ##0,00 - отобразит деление на 1000 в формате ячейки

Ваше имя:

Ваш e-mail (необязательно):

Сообщение:

Captcha