En ThisWorkbook:
Option Explicit
Private Sub Workbook_SheetFollowHyperlink(ByVal Sh As Object, ByVal Target As Hyperlink)
'---------------------------------------------------------------------------------------
' Procedure : Workbook_SheetFollowHyperlink
' Datetime : 14/10/2020 13:56
' Author : Aitor Solozabal Merino - aitorsolozabal@gmail.com
' Purpose : Return the the address of the cell when the user click on the link with the
' name of a table in the database
'---------------------------------------------------------------------------------------
'
Dim rango As String
10 On Error GoTo Workbook_SheetFollowHyperlink_Error
20 rango = Target.Range.Address
'MsgBox "'" & Sh.Name & "'!" & Target.Range.Address & " = " & Worksheets(Sh.Name).Range(rango).Value
30 Call ReadMySqlTable(Worksheets(Sh.Name).Range(rango).Value)
40 On Error GoTo 0
50 Exit Sub
Workbook_SheetFollowHyperlink_Error:
60 MsgBox "Error " & Err.Number & " (" & Err.Description & ") in line " & Erl & " in procedure Workbook_SheetFollowHyperlink of ThisWorkbook"End Sub
En Modulo1:
Option Explicit
'---------------------------------------------------------------------------------------
' Program : Access to a any remote MySQL DataBase Tables
' Datetime : 14/10/2020 13:56
' Author : Aitor Solozabal Merino - aitorsolozabal@gmail.com
' Purpose : Accesing to a remote MySql Server Database and show the data inside their tables
'---------------------------------------------------------------------------------------
'
'Global Variables
Dim oConn As ADODB.Connection
Function Connect_to_MySQL_Database() As Boolean
'---------------------------------------------------------------------------------------
' Procedure : Connect_to_MySQL_Database
' Datetime : 14/10/2020 13:56
' Author : Aitor Solozabal Merino - aitorsolozabal@gmail.com
' Purpose : Set the connection with a remote MySql Server Database from data in cells
'---------------------------------------------------------------------------------------
'
Dim DRIVER, SERVER, PORT As String
Dim DATABASE As String
Dim UID As String
Dim PWD As String
Dim Connect_String As String
10 On Error GoTo Connect_to_MySQL_Database_Error
20 Set oConn = New ADODB.Connection
30 Connect_to_MySQL_Database = False
40 DRIVER = Worksheets("MySQL_Connection_Parameters").Cells(2, 2).Value '"MySQL ODBC 8.0 Unicode Driver"50 SERVER = Worksheets("MySQL_Connection_Parameters").Cells(3, 2).Value '"153.92.6.127 for Hostinger hosting Server"60 PORT = Worksheets("MySQL_Connection_Parameters").Cells(4, 2).Value '"3306"70 DATABASE = Worksheets("MySQL_Connection_Parameters").Cells(5, 2).Value 'u963209217 Database Name80 UID = Worksheets("MySQL_Connection_Parameters").Cells(6, 2).Value 'u963209217admin User Name90 PWD = Worksheets("MySQL_Connection_Parameters").Cells(7, 2).Value 'u963209217@admin User Password100 Connect_String = "Driver={" & DRIVER & "};SERVER=" & SERVER & ";DATABASE=" & DATABASE & ";PORT=" & PORT & ";UID=" & UID & ";PWD=" & PWD & ";"110 If (Connect_String <> "") Then
120 oConn.Open Connect_String
130 If Not oConn Is Nothing Then
140 Connect_to_MySQL_Database = True
150 Else
160 MsgBox "Error: There is not a VALID connection with this remote MySql DATABASE"
170 End If
180 Else
190 MsgBox ("ERROR: Connection " & Connect_String & " FAILED")200 End If
210 On Error GoTo 0
220 Exit Function
Connect_to_MySQL_Database_Error:
230 MsgBox "Error " & Err.Number & " (" & Err.Description & ") in line " & Erl & " in procedure Connect_to_MySQL_Database of Function Módulo1"End Function
Public Sub ReadMySqlDataBase()
'---------------------------------------------------------------------------------------
' Procedure : ReadMySqlDataBase
' Datetime : 14/10/2020 13:56
' Author : Aitor Solozabal Merino - aitorsolozabal@gmail.com
' Purpose : Return the list of tables that exist in database
'---------------------------------------------------------------------------------------
'
Dim DATABASE As String
Dim message As String
Dim rs As ADODB.Recordset
Dim sql_query As String
Dim header As Field
Dim intCol As Integer
Dim rango As String
Dim n As Integer
Dim ultimafila As Integer
Dim i As Integer
10 On Error GoTo ReadMySqlDataBase_Error
'==========================================================================================
20 DATABASE = Worksheets("MySQL_Connection_Parameters").Cells(5, 2).Value30 If Connect_to_MySQL_Database() Then
40 Speedon
50 sql_query = "SHOW TABLES FROM " + DATABASE + ";"
60 Set rs = New ADODB.Recordset
70 rs.Open sql_query, oConn, adOpenDynamic, adLockOptimistic
'check for data
80 If (rs.EOF And rs.BOF) Then
90 message = "Error...No data returned." + vbCrLf
100 message = message + "Offending sql_query:" + vbCrLf
110 message = message + "---------------------------" + vbCrLf
120 message = message + sql_query + vbCrLf
130 message = message + "---------------------------" + vbCrLf
140 MsgBox message
150 Else
'clean sheet "Table_Data_Rows"
160 Worksheets("Table_Data_Rows").Cells.Clear170 Worksheets("Table_Data_Rows").Cells.ClearContents180 Application.CutCopyMode = False
'clean sheet "Table_Fields_Columns"
190 Worksheets("Table_Fields_Columns").Cells.Clear200 Worksheets("Table_Fields_Columns").Cells.ClearContents210 Application.CutCopyMode = False
'clean sheet "Database_Tables"
220 Worksheets("Database_Tables").Cells.Clear230 Worksheets("Database_Tables").Cells.ClearContents240 Application.CutCopyMode = False
250 Worksheets("Database_Tables").Activate260 intCol = 0
270 For Each header In rs.Fields
280 Range("A1").Cells(1, 1).Offset(0, intCol).Value = header.Name290 intCol = intCol + 1
300 Next header
310 ActiveSheet.Range("A2").CopyFromRecordset rs320 rs.Close
330 Set rs = Nothing
'formating the headers of columns intcol from 0=A to intcol=???
340 rango = "A1:A1"
350 Range(rango).Select
360 Selection.Font.Bold = True
370 With Selection.Interior
380 .Pattern = xlSolid
390 .PatternColorIndex = xlAutomatic
400 .ThemeColor = xlThemeColorLight1
410 .TintAndShade = 0
420 .PatternTintAndShade = 0
430 End With
440 With Selection.Font
450 .ThemeColor = xlThemeColorDark1
460 .TintAndShade = 0
470 End With
480 Cells.Select
490 Selection.AutoFilter
500 Selection.Columns.AutoFit
510 Selection.Rows.AutoFit
520 Range("A1").Select530 ultimafila = Sheets("Database_Tables").UsedRange.Rows.Count540 For i = 2 To ultimafila
550 Range("A" & Trim(str(i))).Select 'add hiperlink to macro
560 ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:="", SubAddress:=Selection.Address, TextToDisplay:=Selection.Value
570 Next i
'set the first row as fixed
580 Rows("2:2").Select590 With ActiveWindow
600 .SplitColumn = 0
610 .SplitRow = 1
620 End With
630 ActiveWindow.FreezePanes = True
640 End If
650 oConn.Close
660 Set oConn = Nothing
670 Speedoff
680 MsgBox ("Connection SUCCESFUL to " & DATABASE)690 Else
700 MsgBox "Error en Connect_to_MySQL_Database - There is not a connection with the remote MySql SERVER"
710 End If
720 On Error GoTo 0
730 Exit Sub
ReadMySqlDataBase_Error:
740 MsgBox "Error " & Err.Number & " (" & Err.Description & ") in line " & Erl & " in procedure ReadMySqlDataBase"End Sub
Public Sub ReadMySqlTable(TABLE As String)
'---------------------------------------------------------------------------------------
' Procedure : ReadMySqlTable
' Datetime : 14/10/2020 13:56
' Author : Aitor Solozabal Merino - aitorsolozabal@gmail.com
' Purpose : Process to Return the DATA on a TABLE in a MySql DATABASE
' This Subroutine is CALLED FROM the event FollowHyperlink
' in the procedure Workbook_SheetFollowHyperlink in the sheet ThisWorkbook
' when the user click on the cell with the name of a Table in the Database
'---------------------------------------------------------------------------------------
'
Dim DATABASE As String
Dim message As String
Dim rs As ADODB.Recordset
Dim sql_query As String
Dim Connect_String As String
Dim header As Field
Dim intCol As Integer
Dim rango As String
Dim n As Integer
Dim lastcolumn As Long
10 On Error GoTo ReadMySqlTable_Error
20 DATABASE = Worksheets("MySQL_Connection_Parameters").Cells(5, 2).Value 'Split("u963209216_bc3,u963209216_aitor,u963209216_ka2", ",")30 MsgBox "The clicked table is " & TABLE
40 If TABLE <> "" Then
50 If Connect_to_MySQL_Database() Then
60 Speedon
'clean sheet "Table_Data_Rows"
70 Worksheets("Table_Data_Rows").Cells.Clear80 Worksheets("Table_Data_Rows").Cells.ClearContents90 Application.CutCopyMode = False
'clean sheet "Table_Fields_Columns"
100 Worksheets("Table_Fields_Columns").Cells.Clear110 Worksheets("Table_Fields_Columns").Cells.ClearContents120 Application.CutCopyMode = False
130 If ReadMySqlTableFields(TABLE) Then
140 Worksheets("Table_Fields_Columns").Range("A1:B1").Select150 Selection.Font.Bold = True
160 With Selection.Interior
170 .Pattern = xlSolid
180 .PatternColorIndex = xlAutomatic
190 .ThemeColor = xlThemeColorLight1
200 .TintAndShade = 0
210 .PatternTintAndShade = 0
220 End With
230 With Selection.Font
240 .ThemeColor = xlThemeColorDark1
250 .TintAndShade = 0
260 End With
270 Worksheets("Table_Fields_Columns").Range("A:B").Select280 Selection.AutoFilter
290 Selection.Columns.AutoFit
300 Selection.Rows.AutoFit
310 Range("A1").Select320 Application.CutCopyMode = False
'============================================
330 If ReadMySqlTableRows(TABLE) Then
340 Speedoff
350 lastcolumn = Sheets("Table_Data_Rows").UsedRange.Columns.Count360 Worksheets("Table_Data_Rows").Range("A:" & Number2Letter(lastcolumn)).Select370 Selection.AutoFilter
380 Selection.Columns.AutoFit
390 Selection.Rows.AutoFit
400 Range("A1").Select410 Application.CutCopyMode = False
'mostrar el formulario para editar la hoja
420 Worksheets("Table_Data_Rows").ShowDataForm430 Else
440 MsgBox "Error: There are not DATA ROWS in this Table(" & TABLE & ")"450 End If
460 Else
470 MsgBox "Error: There are not DATA FIELDS DEFINED in this in this Table(" & TABLE & ")"480 End If
490 oConn.Close
500 Set oConn = Nothing
510 Speedoff
520 Else
530 MsgBox "Error en Connect_to_MySQL_Database - There is not a connection with the remote MySql SERVER"
540 End If
550 End If
560 On Error GoTo 0
570 Exit Sub
ReadMySqlTable_Error:
580 MsgBox "Error " & Err.Number & " (" & Err.Description & ") in line " & Erl & " in procedure ReadMySqlTable"End Sub
Public Function ReadMySqlTableFields(TABLE As String) As Boolean
'---------------------------------------------------------------------------------------
' Procedure : ReadMySqlTableFields
' Datetime : 14/10/2020 13:56
' Author : Aitor Solozabal Merino - aitorsolozabal@gmail.com
' Purpose : Return the list of FIELDS(COLUMNS) names and types of a TABLE in a MySql DATABASE
' and show in the sheet Columnas
'---------------------------------------------------------------------------------------
'
Dim DATABASE As String
Dim message As String
Dim rs As ADODB.Recordset
Dim sql_query As String
Dim Connect_String As String
Dim header As Field
Dim intCol As Integer
Dim rango As String
Dim n As Integer
10 On Error GoTo ReadMySqlTableFields_Error
20 DATABASE = Worksheets("MySQL_Connection_Parameters").Cells(5, 2).Value30 ReadMySqlTableFields = False
'===========================================
40 Worksheets("Table_Fields_Columns").Activate '===========================================
50 Range("A1").Select60 sql_query = "show columns from " + TABLE + ";"
70 MsgBox sql_query
80 Set rs = New ADODB.Recordset
90 rs.Open sql_query, oConn, adOpenDynamic, adLockOptimistic
'check for data
100 If (rs.EOF And rs.BOF) Then
110 message = "Error...No data returned." + vbCrLf
120 message = message + "Offending sql_query:" + vbCrLf
130 message = message + "---------------------------" + vbCrLf
140 message = message + sql_query + vbCrLf
150 message = message + "---------------------------" + vbCrLf
160 MsgBox message
170 Else
180 ReadMySqlTableFields = True
190 intCol = 0
200 For Each header In rs.Fields
210 Range("A1").Cells(1, 1).Offset(0, intCol).Value = header.Name220 intCol = intCol + 1
230 Next header
240 Range("A2").CopyFromRecordset rs250 rs.Close
260 Set rs = Nothing
'set the first row as fixed
270 Rows("2:2").Select280 With ActiveWindow
290 .SplitColumn = 0
300 .SplitRow = 1
310 End With
320 ActiveWindow.FreezePanes = True
330 End If
340 On Error GoTo 0
350 Exit Function
ReadMySqlTableFields_Error:
360 MsgBox "Error " & Err.Number & " (" & Err.Description & ") in line " & Erl & " in procedure ReadMySqlTableFields"End Function
Public Function ReadMySqlTableRows(TABLE As String) As Boolean
'---------------------------------------------------------------------------------------
' Procedure : ReadMySqlTableRows
' Datetime : 14/10/2020 13:56
' Author : Aitor Solozabal Merino - aitorsolozabal@gmail.com
' Purpose : Return the DATA ROWS of a TABLE in a MySql DATABASE
'---------------------------------------------------------------------------------------
'
Dim message As String
Dim rs As ADODB.Recordset
Dim sql_query As String
Dim Connect_String As String
Dim header As Field
Dim intCol As Integer
Dim rango As String
Dim n As Integer
10 On Error GoTo ReadMySqlTableRows_Error
20 ReadMySqlTableRows = False
'===========================================
30 Worksheets("Table_Data_Rows").Activate '===========================================
40 Range("A1").Select50 sql_query = "SELECT * FROM " + TABLE + ";"
60 Set rs = New ADODB.Recordset
70 rs.Open sql_query, oConn, adOpenDynamic, adLockOptimistic
'check for data
80 If (rs.EOF And rs.BOF) Then
90 message = "Error...No data returned." + vbCrLf
100 message = message + "Offending sql_query:" + vbCrLf
110 message = message + "---------------------------" + vbCrLf
120 message = message + sql_query + vbCrLf
130 message = message + "---------------------------" + vbCrLf
140 MsgBox message
150 Else
160 ReadMySqlTableRows = True
170 intCol = 0
180 For Each header In rs.Fields
190 Range("A1").Cells(1, 1).Offset(0, intCol).Value = header.Name200 intCol = intCol + 1
210 Next header
'copiar el resultado a la hoja
220 Range("A2").CopyFromRecordset rs230 rs.Close
240 Set rs = Nothing
'============================================
'formatear la cabecera de las columnas
'intcol from 0=A to intcol=???
250 rango = "A1:" & Number2Letter(intCol) & "1"
260 Range(rango).Select
270 Selection.Font.Bold = True
280 With Selection.Interior
290 .Pattern = xlSolid
300 .PatternColorIndex = xlAutomatic
310 .ThemeColor = xlThemeColorLight1
320 .TintAndShade = 0
330 .PatternTintAndShade = 0
340 End With
350 With Selection.Font
360 .ThemeColor = xlThemeColorDark1
370 .TintAndShade = 0
380 End With
'=============================================================================================
'tercero formatear las columnas en la hoja "Table_Data_Rows" conforme al DataType en la hoja "Table_Fields_Columns"
'=============================================================================================
390 For n = 1 To intCol
400 rango = Number2Letter(n) & ":" & Number2Letter(n)
410 Select Case UCase(Worksheets("Table_Fields_Columns").Cells(n + 1, 2).Value) Case "CHAR", "VARCHAR", "TINYTEXT", "TEXT", "MEDIUMTEXT", "LONGTEXT"
' CHAR A fixed-length nonbinary (character) string
' VARCHAR A variable-length non-binary string
' TINYTEXT A very small non-binary string
' TEXT A small non-binary string
' MEDIUMTEXT A medium-sized non-binary string
' LONGTEXT A large non-binary string
420 Columns(rango).Select
430 Selection.NumberFormat = "@"
'Debug.Print "ALFANUMERICO = " & UCase(Worksheets("Table_Fields_Columns").Cells(n + 1, 2).Value) & " Rango=" & Rango440 Case "TINYINT", "SMALLINT", "MEDIUMINT", "INT", "BIGINT", "BIT"
' TINYINT A very small integer
' SMALLINT A small integer
' MEDIUMINT A medium-sized integer
' INT A standard integer
' BIGINT A large integer
' BIT A bit field
450 Columns(rango).Select
460 Selection.NumberFormat = "0"
'Debug.Print "NUMERICO INTEGER = " & UCase(Worksheets("Table_Fields_Columns").Cells(n + 1, 2).Value) & " Rango=" & Rango470 Case "DECIMAL"
' DECIMAL A fixed-point number
480 Columns(rango).Select
490 Selection.NumberFormat = "#,##0.00_ ;[Red]-#,##0.00 "
'Debug.Print "NUMERICO FLOAT = " & UCase(Worksheets("Table_Fields_Columns").Cells(n + 1, 2).Value)500 Case "FLOAT", "DOUBLE"
' FLOAT A single-precision floating point number
' DOUBLE A double-precision floating point number
'ver punto decimal
510 Columns(rango).Select
'Selection.NumberFormat = "0.00"
520 Selection.NumberFormat = "General"
'Debug.Print "NUMERICO FLOAT = " & UCase(Worksheets("Table_Fields_Columns").Cells(n + 1, 2).Value)530 Case "TINYINT(1)"
540 Columns(rango).Select
'Selection.NumberFormat = "0.00"
550 Selection.NumberFormat = "General"
'Debug.Print "BOOLEAN = " & UCase(Worksheets("Table_Fields_Columns").Cells(n + 1, 2).Value) & " Rango=" & Rango560 Case "DATE"
' DATE A date value in CCYY-MM-DD format
570 Columns(rango).Select
580 Selection.NumberFormat = "yyyy-mm-dd;@"
'Debug.Print "FECHA = " & UCase(Worksheets("Table_Fields_Columns").Cells(n + 1, 2).Value) & " Rango=" & Rango590 Case "DATETIME", "TIMESTAMP", "YEAR"
' DATETIME A date and time value in CCYY-MM-DD hh:mm:ssformat
' TIMESTAMP A timestamp value in CCYY-MM-DD hh:mm:ss format
600 Columns(rango).Select
610 Selection.NumberFormat = "yyyy/mm/dd h:mm"
'Debug.Print "FECHA = " & UCase(Worksheets("Table_Fields_Columns").Cells(n + 1, 2).Value) & " Rango=" & rango620 Case "YEAR"
' YEAR A year value in CCYY or YY format
630 Columns(rango).Select
640 Selection.NumberFormat = "yyyy"
'Debug.Print "FECHA = " & UCase(Worksheets("Table_Fields_Columns").Cells(n + 1, 2).Value) & " Rango=" & Rango650 Case "TIME"
' TIME A time value in hh:mm:ss format
660 Columns(rango).Select
670 Selection.NumberFormat = "h:mm:ss;@"
'Debug.Print "FECHA = " & UCase(Worksheets("Table_Fields_Columns").Cells(n + 1, 2).Value) & " Rango=" & Rango680 Case Else ' Other values.
' BINARY A fixed-length binary string
' VARBINARY A variable-length binary string
' TINYBLOB A very small BLOB (binary large object)
' BLOB A small BLOB
' MEDIUMBLOB A medium-sized BLOB
' LONGBLOB A large BLOB
' ENUM An enumeration; each column value may be assigned one enumeration member
' SET A set; each column value may be assigned zero or more SET members
' GEOMETRY A spatial value of any type
' POINT A point (a pair of X-Y coordinates)
' LINESTRING A curve (one or more POINT values)
' POLYGON A polygon
' GEOMETRYCOLLECTION A collection of GEOMETRY values
' MULTILINESTRING A collection of LINESTRING values
' MULTIPOINT A collection of POINT values
' MULTIPOLYGON A collection of POLYGON values
690 Columns(rango).Select
700 Selection.NumberFormat = "General"
'Debug.Print "TIPO = " & UCase(Worksheets("Table_Fields_Columns").Cells(n + 1, 2).Value) & " Rango=" & Rango710 End Select
720 Next
730 Range("A1").Select740 End If
750 On Error GoTo 0
760 Exit Function
ReadMySqlTableRows_Error:
770 MsgBox "Error " & Err.Number & " (" & Err.Description & ") in line " & Erl & " in procedure ReadMySqlTableRows"End Function
Private Sub Speedoff()
'---------------------------------------------------------------------------------------
' Procedure : Speedoff
' Datetime : 14/06/2018 13:56
' Author : Aitor Solozabal Merino - aitorsolozabal@gmail.com
' Purpose : Set the normal speed conditions
'---------------------------------------------------------------------------------------
'
10 On Error GoTo Speedoff_Error
20 With Application
30 .ScreenUpdating = True
40 .EnableEvents = True
50 .DisplayAlerts = True
60 .CalculateBeforeSave = True
70 .Cursor = xlDefault
80 .StatusBar = vbNullString
90 .EnableCancelKey = xlInterrupt
100 .CalculateFullRebuild
110 .Calculation = xlCalculationAutomatic
120 End With
130 Range("A1").Copy Range("A1") 'Clearundo140 On Error GoTo 0
150 Exit Sub
Speedoff_Error:
160 MsgBox "Error " & Err.Number & " (" & Err.Description & ") In Procedure Speedoff, Line " & Erl & "."End Sub
Private Sub Speedon()
'---------------------------------------------------------------------------------------
' Procedure : Speedon
' Datetime : 14/06/2018 13:56
' Author : Aitor Solozabal Merino - aitorsolozabal@gmail.com
' Purpose : Set the optimal speed conditions
'---------------------------------------------------------------------------------------
'
10 On Error GoTo Speedon_Error
20 ActiveWorkbook.PrecisionAsDisplayed = True
30 ActiveWindow.DisplayZeros = False
40 With Application
50 .CutCopyMode = False
60 .ScreenUpdating = False
70 .EnableEvents = False
80 .DisplayAlerts = False
'.Cursor = Xlwait
90 .StatusBar = vbNullString
100 .EnableCancelKey = xlErrorHandler
110 .DisplayStatusBar = True
120 .Calculation = xlCalculationManual ' Poner Modo De Calculo Manual Para Mas Rapidez
130 .CalculateBeforeSave = False ' Calcular Antes De Salvar Falso
140 .MaxChange = 0.001
150 End With
160 Range("A1").Copy Range("A1") 'Clearundo170 On Error GoTo 0
180 Exit Sub
Speedon_Error:
190 MsgBox "Error " & Err.Number & " (" & Err.Description & ") In Procedure Speedon, Line " & Erl & "."End Sub
Function Number2Letter(ByVal intcolumn As Long) As String
'---------------------------------------------------------------------------------------
' Procedure : Number2Letter
' Datetime : 14/06/2018 13:56
' Author : Aitor Solozabal Merino - aitorsolozabal@gmail.com
' Purpose : Return Column LETTER from a Column NUMBER
'---------------------------------------------------------------------------------------
'
10 On Error GoTo Number2Letter_Error
20 Number2Letter = Split(Cells(1, intcolumn).Address, "$")(1)
30 On Error GoTo 0
40 Exit Function
Number2Letter_Error:
50 MsgBox "Error " & Err.Number & " (" & Err.Description & ") in procedure Number2Letter Line " & Erl & "."End Function
Crear cuenta
Pantalla de las tablas existentes en la base de datos indicada en la pantalla inicial.
Una vez seleccionada una tabla y pulsar con el ratón encima de ella se extraen los datos de la tabla en 2 solapas.
Esta es la pantalla de la solapa con los campos de la tabla y su tipo (que será usado para formatear adecuadamente las celdas con los datos de los registros).
Esta es la pantalla de la solapa de los datos de los registros en la tabla seleccionada.
Para bajarse el fichero con la macro y el código VBA seguir el siguiente enlace (hay que cambiar los datos para acceder al servidor remoto):
https://www.bc3toexcel.com/compartir/VBA_Application_to_access_data_in_a_remote_MySQL_Database_Table.xlsm