Excel Table(s) to MySQL
This example sends data from Excel to online SQL database.
Screenshots
Click to view large-sized image
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:
Feedback
Submit and view feedback