Excel Table(s) to MySQL

This example sends data from Excel to online SQL database.

Screenshots

Front Sheet

Click to view large-sized image

Monthly Table

Click to view large-sized image

VBA Module Code - Connecting to Database

VBA

Sub sbUpdateMySQL()

If ActiveSheet.ProtectContents = False Then
    MsgBox "NOTE:" & Chr(13) & "The sheet must be first LOCKED for submission, before records can be SUBMITTED", vbExclamation, "Please Lock for Submission!"
    
Else
    
    Dim answer As Integer
    answer = MsgBox("NOTE:" & Chr(13) & "Are you sure you want to SUBMIT these records for " & ActiveSheet.Name & " ?", vbYesNo + vbQuestion, "Please Confirm!")

If answer = vbYes Then

    'DECLARE VARIABLES'
        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 Int_line As Integer
        Dim Count As Integer
        Dim Count2 As Integer
        Dim Update As Integer
        Dim Skip As Integer
        
        Dim Field0 As String
        Dim Field1 As String
        Dim Field2 As String
        Dim Field3 As String
        Dim Field4 As String
        Dim Field5 As String
        
        
    'OPEN CONNECTION
        objMyConn.Open "DRIVER={MySQL ODBC 5.3 ANSI Driver};" & _
        "SERVER=sql2.freesqldatabase.com;" & _
        "DATABASE=sql2208694;" & _
        "USER=sql2208694;" & _
        "PASSWORD=kG3!iA3%;" & _
        "Option=3"
        
        Set objMyCmd.ActiveConnection = objMyConn
        
        Int_line = 4
        Count = 0
        Count2 = 0
        Skip = 0
        Update = 0
        
        Do While ActiveSheet.Range("F" & Int_line).Value <> ""
        
        Field0 = ActiveSheet.Range("F" & Int_line).Value
        Field1 = ActiveSheet.Range("G" & Int_line).Value
        Field2 = ActiveSheet.Range("H" & Int_line).Value
        Field3 = ActiveSheet.Range("I" & Int_line).Value
        Field4 = ActiveSheet.Range("J" & Int_line).Value
        Field5 = ActiveSheet.Range("K" & Int_line).Value
    
        'SQL = "INSERT INTO Transactions (Account) SELECT '" & esc(Trim(.Cells(int_line, 6).Value)) & "' "
        'SQL = SQL & "FROM Transactions WHERE NOT EXISTS (SELECT Account FROM Transactions WHERE Account = '" & esc(Trim(.Cells(int_line, 6).Value)) & "' ) LIMIT 1"
        
        SQL = "SELECT * from Transactions where Transaction = '" & Field0 & "' "
            
        objMyRecordset.Open SQL, objMyConn, adOpenDynamic, adLockOptimistic
           
        If objMyRecordset.EOF <> True And objMyRecordset.BOF <> True Then
           
            If Skip <> 1 Then
           
                Dim answer2 As Integer
                answer2 = MsgBox("NOTE:" & Chr(13) & "Some records already exist for this month!" & Chr(13) & "Do you want to update these records too?", vbYesNo + vbQuestion, "Please Confirm!")
                Skip = 1
                
                If answer2 = vbYes Then
                    Count2 = Count2 + 1
                    Update = 1
                    objMyRecordset.Update
        
                    objMyRecordset.Fields("Transaction") = Field0
                    objMyRecordset.Fields("Description") = Field1
                    objMyRecordset.Fields("Analysis") = Field2
                    objMyRecordset.Fields("Ref") = Field3
                    objMyRecordset.Fields("Start_date") = Field4
                    objMyRecordset.Fields("Tax_date") = Field5
                    objMyRecordset.Fields("Account") = "Wunderman"
        
                    objMyRecordset.Update
                    objMyRecordset.Close
        
                Else
                    'Don't Update Recordset
                    objMyRecordset.Close
        
                End If
        
            Else
            
                If Update = 1 Then
                    Count2 = Count2 + 1
                    objMyRecordset.Update
        
                    objMyRecordset.Fields("Transaction") = Field0
                    objMyRecordset.Fields("Description") = Field1
                    objMyRecordset.Fields("Analysis") = Field2
                    objMyRecordset.Fields("Ref") = Field3
                    objMyRecordset.Fields("Start_date") = Field4
                    objMyRecordset.Fields("Tax_date") = Field5
                    objMyRecordset.Fields("Account") = "Wunderman"
        
                    objMyRecordset.Update
                    objMyRecordset.Close
        
                Else
                    'Don't Update Recordset
                    objMyRecordset.Close
        
                End If
           
            End If
        
        
        Else
           
            objMyRecordset.AddNew
        
            objMyRecordset.Fields("Transaction") = Field0
            objMyRecordset.Fields("Description") = Field1
            objMyRecordset.Fields("Analysis") = Field2
            objMyRecordset.Fields("Ref") = Field3
            objMyRecordset.Fields("Start_date") = Field4
            objMyRecordset.Fields("Tax_date") = Field5
            objMyRecordset.Fields("Account") = "Wunderman"
        
            objMyRecordset.Update
            objMyRecordset.Close
            Count = Count + 1
        
        End If
        
            Int_line = Int_line + 1
        
        Loop
        
        Range("A1").Select
        MsgBox Count & " New Records were successfully submitted" & Chr(13) & Count2 & " Existing Records were successfully updated"
        
        
        objMyConn.Close
        'objMyRecordset.Close
     
        
        'ActiveSheet.Unprotect "007050609WunderRockPossible"
        'ActiveSheet.Shapes.Range(Array("Submit to Database")).Select
        'Selection.Delete
        'ActiveSheet.Protect "007050609WunderRockPossible", True, True

Else
    'do nothing
End If

End If

End Sub

Function esc(txt As String)
esc = Trim(Replace(txt, "'", "\'"))
End Function

VBA Module Code - Locking Sheets

VBA

Sub sbProtectSheetJan()

Dim answer As Integer
answer = MsgBox("NOTE:" & Chr(13) & "Are you sure you want to LOCK the submission for January?" & Chr(13) & "You will not be able to unlock the submission after this step.", vbYesNo + vbQuestion, "Please Confirm!")

If answer = vbYes Then
 
    ActiveSheet.Protect "007050609WunderRockPossible", True, True
    
    Sheets("Summary").Select
    ActiveSheet.Unprotect "007050609WunderRockPossible"
    
    Range("C6").Select
    ActiveCell.FormulaR1C1 = "ü"
    
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    
    Selection.Font.Size = 14
    
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .ThemeColor = xlThemeColorAccent6
        .TintAndShade = 0.799981688894314
        .PatternTintAndShade = 0
    End With
    
    ActiveSheet.Protect "007050609WunderRockPossible", True, True
    
    Sheets("Jan").Select
    Range("A1").Select
    MsgBox "January's data has been successfully LOCKED for submission" & Chr(13) & "These records can now be SUBMITTED", vbInformation, "Successfully Locked"
       
Else
    'do nothing
End If

End Sub



Sub sbProtectSheetFeb()

Dim answer As Integer
answer = MsgBox("NOTE:" & Chr(13) & "Are you sure you want to LOCK the submission for February?" & Chr(13) & "You will not be able to unlock the submission after this step.", vbYesNo + vbQuestion, "Please Confirm!")

If answer = vbYes Then
 
    ActiveSheet.Protect "007050609WunderRockPossible", True, True
    
    Sheets("Summary").Select
    ActiveSheet.Unprotect "007050609WunderRockPossible"
    
    Range("D6").Select
    ActiveCell.FormulaR1C1 = "ü"
    
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    
    Selection.Font.Size = 14
    
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .ThemeColor = xlThemeColorAccent6
        .TintAndShade = 0.799981688894314
        .PatternTintAndShade = 0
    End With
    
    ActiveSheet.Protect "007050609WunderRockPossible", True, True
    
    Sheets("Feb").Select
    Range("A1").Select
    MsgBox "February's data has been successfully LOCKED for submission" & Chr(13) & "These records can now be SUBMITTED", vbInformation, "Successfully Locked"
     
Else
    'do nothing
End If

End Sub



Sub sbProtectSheetMar()

Dim answer As Integer
answer = MsgBox("NOTE:" & Chr(13) & "Are you sure you want to LOCK the submission for March?" & Chr(13) & "You will not be able to unlock the submission after this step.", vbYesNo + vbQuestion, "Please Confirm!")

If answer = vbYes Then
 
    ActiveSheet.Protect "007050609WunderRockPossible", True, True
    
    Sheets("Summary").Select
    ActiveSheet.Unprotect "007050609WunderRockPossible"
    
    Range("E6").Select
    ActiveCell.FormulaR1C1 = "ü"
    
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    
    Selection.Font.Size = 14
    
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .ThemeColor = xlThemeColorAccent6
        .TintAndShade = 0.799981688894314
        .PatternTintAndShade = 0
    End With
    
    ActiveSheet.Protect "007050609WunderRockPossible", True, True
    
    Sheets("Mar").Select
    Range("A1").Select
    MsgBox "March's data has been successfully LOCKED for submission" & Chr(13) & "These records can now be SUBMITTED", vbInformation, "Successfully Locked"
   
Else
    'do nothing
End If

End Sub


Sub sbProtectSheetApr()

Dim answer As Integer
answer = MsgBox("NOTE:" & Chr(13) & "Are you sure you want to LOCK the submission for April?" & Chr(13) & "You will not be able to unlock the submission after this step.", vbYesNo + vbQuestion, "Please Confirm!")

If answer = vbYes Then
 
    ActiveSheet.Protect "007050609WunderRockPossible", True, True
    
    Sheets("Summary").Select
    ActiveSheet.Unprotect "007050609WunderRockPossible"
    
    Range("F6").Select
    ActiveCell.FormulaR1C1 = "ü"
    
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    
    Selection.Font.Size = 14
    
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .ThemeColor = xlThemeColorAccent6
        .TintAndShade = 0.799981688894314
        .PatternTintAndShade = 0
    End With
    
    ActiveSheet.Protect "007050609WunderRockPossible", True, True
    
    Sheets("Apr").Select
    Range("A1").Select
    MsgBox "April's data has been successfully LOCKED for submission" & Chr(13) & "These records can now be SUBMITTED", vbInformation, "Successfully Locked"

Else
    'do nothing
End If

End Sub



Sub sbProtectSheetMay()

Dim answer As Integer
answer = MsgBox("NOTE:" & Chr(13) & "Are you sure you want to LOCK the submission for May?" & Chr(13) & "You will not be able to unlock the submission after this step.", vbYesNo + vbQuestion, "Please Confirm!")

If answer = vbYes Then
 
    ActiveSheet.Protect "007050609WunderRockPossible", True, True
    
    Sheets("Summary").Select
    ActiveSheet.Unprotect "007050609WunderRockPossible"
    
    Range("G6").Select
    ActiveCell.FormulaR1C1 = "ü"
    
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    
    Selection.Font.Size = 14
    
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .ThemeColor = xlThemeColorAccent6
        .TintAndShade = 0.799981688894314
        .PatternTintAndShade = 0
    End With
    
    ActiveSheet.Protect "007050609WunderRockPossible", True, True
    
    Sheets("May").Select
    Range("A1").Select
    MsgBox "May's data has been successfully LOCKED for submission" & Chr(13) & "These records can now be SUBMITTED", vbInformation, "Successfully Locked"
    
Else
    'do nothing
End If

End Sub
    
    

Sub sbProtectSheetJun()

Dim answer As Integer
answer = MsgBox("NOTE:" & Chr(13) & "Are you sure you want to LOCK the submission for June?" & Chr(13) & "You will not be able to unlock the submission after this step.", vbYesNo + vbQuestion, "Please Confirm!")

If answer = vbYes Then
 
    ActiveSheet.Protect "007050609WunderRockPossible", True, True
    
    Sheets("Summary").Select
    ActiveSheet.Unprotect "007050609WunderRockPossible"
    
    Range("H6").Select
    ActiveCell.FormulaR1C1 = "ü"
    
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    
    Selection.Font.Size = 14
    
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .ThemeColor = xlThemeColorAccent6
        .TintAndShade = 0.799981688894314
        .PatternTintAndShade = 0
    End With
    
    ActiveSheet.Protect "007050609WunderRockPossible", True, True
    
    Sheets("Jun").Select
    Range("A1").Select
    MsgBox "June's data has been successfully LOCKED for submission" & Chr(13) & "These records can now be SUBMITTED", vbInformation, "Successfully Locked"
      
Else
    'do nothing
End If

End Sub



Sub sbProtectSheetJul()

Dim answer As Integer
answer = MsgBox("NOTE:" & Chr(13) & "Are you sure you want to LOCK the submission for July?" & Chr(13) & "You will not be able to unlock the submission after this step.", vbYesNo + vbQuestion, "Please Confirm!")

If answer = vbYes Then
 
    ActiveSheet.Protect "007050609WunderRockPossible", True, True
    
    Sheets("Summary").Select
    ActiveSheet.Unprotect "007050609WunderRockPossible"
    
    Range("I6").Select
    ActiveCell.FormulaR1C1 = "ü"
    
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    
    Selection.Font.Size = 14
    
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .ThemeColor = xlThemeColorAccent6
        .TintAndShade = 0.799981688894314
        .PatternTintAndShade = 0
    End With
    
    ActiveSheet.Protect "007050609WunderRockPossible", True, True
    
    Sheets("Jul").Select
    Range("A1").Select
    MsgBox "July's data has been successfully LOCKED for submission" & Chr(13) & "These records can now be SUBMITTED", vbInformation, "Successfully Locked"
      
Else
    'do nothing
End If

End Sub



Sub sbProtectSheetAug()

Dim answer As Integer
answer = MsgBox("NOTE:" & Chr(13) & "Are you sure you want to LOCK the submission for August?" & Chr(13) & "You will not be able to unlock the submission after this step.", vbYesNo + vbQuestion, "Please Confirm!")

If answer = vbYes Then
 
    ActiveSheet.Protect "007050609WunderRockPossible", True, True
    
    Sheets("Summary").Select
    ActiveSheet.Unprotect "007050609WunderRockPossible"
    
    Range("J6").Select
    ActiveCell.FormulaR1C1 = "ü"
    
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    
    Selection.Font.Size = 14
    
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .ThemeColor = xlThemeColorAccent6
        .TintAndShade = 0.799981688894314
        .PatternTintAndShade = 0
    End With
    
    ActiveSheet.Protect "007050609WunderRockPossible", True, True
    
    Sheets("Aug").Select
    Range("A1").Select
    MsgBox "August's data has been successfully LOCKED for submission" & Chr(13) & "These records can now be SUBMITTED", vbInformation, "Successfully Locked"
    
Else
    'do nothing
End If

End Sub



Sub sbProtectSheetSep()

Dim answer As Integer
answer = MsgBox("NOTE:" & Chr(13) & "Are you sure you want to LOCK the submission for September?" & Chr(13) & "You will not be able to unlock the submission after this step.", vbYesNo + vbQuestion, "Please Confirm!")

If answer = vbYes Then
 
    ActiveSheet.Protect "007050609WunderRockPossible", True, True
    
    Sheets("Summary").Select
    ActiveSheet.Unprotect "007050609WunderRockPossible"
    
    Range("K6").Select
    ActiveCell.FormulaR1C1 = "ü"
    
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    
    Selection.Font.Size = 14
    
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .ThemeColor = xlThemeColorAccent6
        .TintAndShade = 0.799981688894314
        .PatternTintAndShade = 0
    End With
    
    ActiveSheet.Protect "007050609WunderRockPossible", True, True
    
    Sheets("Sep").Select
    Range("A1").Select
    MsgBox "September's data has been successfully LOCKED for submission" & Chr(13) & "These records can now be SUBMITTED", vbInformation, "Successfully Locked"
    
Else
    'do nothing
End If

End Sub



Sub sbProtectSheetOct()

Dim answer As Integer
answer = MsgBox("NOTE:" & Chr(13) & "Are you sure you want to LOCK the submission for October?" & Chr(13) & "You will not be able to unlock the submission after this step.", vbYesNo + vbQuestion, "Please Confirm!")

If answer = vbYes Then
 
    ActiveSheet.Protect "007050609WunderRockPossible", True, True
    
    Sheets("Summary").Select
    ActiveSheet.Unprotect "007050609WunderRockPossible"
    
    Range("L6").Select
    ActiveCell.FormulaR1C1 = "ü"
    
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    
    Selection.Font.Size = 14
    
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .ThemeColor = xlThemeColorAccent6
        .TintAndShade = 0.799981688894314
        .PatternTintAndShade = 0
    End With
    
    ActiveSheet.Protect "007050609WunderRockPossible", True, True
    
    Sheets("Oct").Select
    Range("A1").Select
    MsgBox "October's data has been successfully LOCKED for submission" & Chr(13) & "These records can now be SUBMITTED", vbInformation, "Successfully Locked"
 
Else
    'do nothing
End If

End Sub



Sub sbProtectSheetNov()

Dim answer As Integer
answer = MsgBox("NOTE:" & Chr(13) & "Are you sure you want to LOCK the submission for November?" & Chr(13) & "You will not be able to unlock the submission after this step.", vbYesNo + vbQuestion, "Please Confirm!")

If answer = vbYes Then
 
    ActiveSheet.Protect "007050609WunderRockPossible", True, True
    
    Sheets("Summary").Select
    ActiveSheet.Unprotect "007050609WunderRockPossible"
    
    Range("M6").Select
    ActiveCell.FormulaR1C1 = "ü"
    
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    
    Selection.Font.Size = 14
    
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .ThemeColor = xlThemeColorAccent6
        .TintAndShade = 0.799981688894314
        .PatternTintAndShade = 0
    End With
    
    ActiveSheet.Protect "007050609WunderRockPossible", True, True
    
    Sheets("Nov").Select
    Range("A1").Select
    MsgBox "November's data has been successfully LOCKED for submission" & Chr(13) & "These records can now be SUBMITTED", vbInformation, "Successfully Locked"

Else
    'do nothing
End If

End Sub



Sub sbProtectSheetDec()

Dim answer As Integer
answer = MsgBox("NOTE:" & Chr(13) & "Are you sure you want to LOCK the submission for December?" & Chr(13) & "You will not be able to unlock the submission after this step.", vbYesNo + vbQuestion, "Please Confirm!")

If answer = vbYes Then
 
    ActiveSheet.Protect "007050609WunderRockPossible", True, True
    
    Sheets("Summary").Select
    ActiveSheet.Unprotect "007050609WunderRockPossible"
    
    Range("N6").Select
    ActiveCell.FormulaR1C1 = "ü"
    
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    
    Selection.Font.Size = 14
    
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .ThemeColor = xlThemeColorAccent6
        .TintAndShade = 0.799981688894314
        .PatternTintAndShade = 0
    End With
    
    ActiveSheet.Protect "007050609WunderRockPossible", True, True
    
    Sheets("Dec").Select
    Range("A1").Select
    MsgBox "December's data has been successfully LOCKED for submission" & Chr(13) & "These records can now be SUBMITTED", vbInformation, "Successfully Locked"
        
Else
    'do nothing
End If

End Sub

Download

The full file can be downloaded here:

VBA - Excel Table to MySQL (xlsm)