MySQL to Excel Table - Ex. 2
This example retrieves data from an online SQL database, and sends the records to the relevant tab, depending on the month of the field called ‘Tax Date’.
Screenshots


Click to view large-sized image
VBA Module Code
VBA
Sub Oval2_Click()
frmData.Show
End Sub
Sub Clear_DataSheet()
Dim this_sheet As Worksheet
Set this_sheet = ActiveSheet
With this_sheet.ListObjects(1)
If Not .DataBodyRange Is Nothing Then
.DataBodyRange.Delete
End If
End With
End Sub
Sub GetDataFromADO()
'Declare variables'
'Dim objMyConn As Object: Set objMyConn = CreateObject("New ADODB.Connection")
'Dim objMyCmd As Object: Set objMyCmd = CreateObject("ADODB.Command")
'Dim objMyRecordset As Object: Set objMyRecordset = CreateObject("ADODB.Recordset")
Dim objMyConn As ADODB.Connection
Dim objMyCmd As ADODB.Command
Dim objMyRecordset As ADODB.Recordset
Set objMyConn = New ADODB.Connection
Set objMyCmd = New ADODB.Command
Set objMyRecordset = New ADODB.Recordset
Dim SQL As String
Dim QT As Excel.QueryTable
Dim ConnectionString
'DECLARE SHEET, TABLE, and ROW variables
Dim this_sheet As Worksheet
Dim table_list_object As ListObject
Dim table_object_row As ListRow
'OPEN CONNECTION
' Open a connection by referencing the ODBC driver.
objMyConn.ConnectionString = "driver={sql server};" & _
"Server=DESKTOP-44LLEA4\SQLEXPRESS;Database=Company_Transactions;Uid=;Pwd=;"
objMyConn.Open
Set objMyCmd.ActiveConnection = objMyConn
'****************************************************************************************************
'****************************************************************************************************
'QUERY RECORDS FROM APRIL
SQL = "SELECT * from Transactions WHERE MONTH(Tax_Date) = 4"
objMyRecordset.Open SQL, objMyConn, adOpenStatic, adLockReadOnly
'SET SHEET to APRIL
Set this_sheet = Sheets("Mth 4")
Set table_list_object = this_sheet.ListObjects(1)
Set table_object_row = table_list_object.ListRows.Add
'ADD APRIL RECORD
With this_sheet.ListObjects(1)
Call table_object_row.Range(1, 1).CopyFromRecordset(objMyRecordset)
'Call table_object_row.Resize(this_sheet.UsedRange)
End With
'Close Objects and Variables
objMyRecordset.Close
'*****************************************************************************************************
'****************************************************************************************************
'****************************************************************************************************
'QUERY RECORDS FROM MAY
SQL = "SELECT * from Transactions WHERE MONTH(Tax_Date) = 5"
objMyRecordset.Open SQL, objMyConn, adOpenStatic, adLockReadOnly
'SET SHEET to MAY
Set this_sheet = Sheets("Mth 5")
Set table_list_object = this_sheet.ListObjects(1)
Set table_object_row = table_list_object.ListRows.Add
'ADD MAY RECORD
With this_sheet.ListObjects(1)
Call table_object_row.Range(1, 1).CopyFromRecordset(objMyRecordset)
'Call table_object_row.Resize(this_sheet.UsedRange)
End With
'Close Objects and Variables
objMyRecordset.Close
'*****************************************************************************************************
'****************************************************************************************************
'****************************************************************************************************
'QUERY RECORDS FROM JUNE
SQL = "SELECT * from Transactions WHERE MONTH(Tax_Date) = 6"
objMyRecordset.Open SQL, objMyConn, adOpenStatic, adLockReadOnly
'SET SHEET to JUNE
Set this_sheet = Sheets("Mth 6")
Set table_list_object = this_sheet.ListObjects(1)
Set table_object_row = table_list_object.ListRows.Add
'ADD JUNE RECORD
With this_sheet.ListObjects(1)
Call table_object_row.Range(1, 1).CopyFromRecordset(objMyRecordset)
'Call table_object_row.Resize(this_sheet.UsedRange)
End With
'Close Objects and Variables
objMyRecordset.Close
'*****************************************************************************************************
'Close Objects and Variables
objMyConn.Close
End Sub
Download
The full file can be downloaded here:
Feedback
Submit and view feedback