Option Explicit
Option Base 1
Sub Create_MySQL_Table_From_Excel()
Dim myItems() As Variant
Dim myItems2() As Variant
Dim SQL_Items_String As Variant
Dim i As Long
Dim bound As Long
Dim c As Variant
Dim LastComma As Integer
Dim TableName As String
Dim conn As New ADODB.Connection
Dim server_name As String
Dim database_name As String
Dim user_id As String
Dim password As String
Dim Length_of_myItems As String
Dim Find_Spaces As Long
Dim Replace_Spaces As Variant
' Table action variables from original post create by other VBAExpress user. Some of these variables are not used.
Dim sqlstr As String ' SQL to perform various actions
Dim table1 As String, table2 As String
Dim field1 As String
Dim rs As ADODB.Recordset
Dim vtype As Variant
Dim k As Integer
' Establish connection to the database
server_name = "localhost" ' Enter your server name here - if running from a local computer use 127.0.0.1
database_name = "vbaexpress" ' Enter your database name here
user_id = "root" ' enter your user ID here
password = "" ' Enter your password here
Set conn = New ADODB.Connection
conn.Open "DRIVER={MySQL ODBC 3.51 Driver}" _
& ";SERVER=" & server_name _
& ";DATABASE=" & database_name _
& ";UID=" & user_id _
& ";PWD=" & password _
& ";OPTION=16427" ' Option 16427 = Convert LongLong to Int: This just helps makes sure that large numeric results get properly interpreted
' Various Actions
' Define variables (not all of the variables will be required for each action)
vtype = Array("Text", "LongText", "Int(10)", "Float", "Double", "Date", "Time") ' array of commonly used MySQL variable types
TableName = "table_from_excel"
' These "with" statments define the dynamic range of the arrays assuming we know the data will start in Cell a1 and b1
With Range("a1")
myItems() = Range(.Offset(0, 0), .End(xlToRight)).Value
End With
'This section removes all spaces in between words and replaces them with an underscore.
'myItemsSpace = myItems
bound = UBound(myItems, 2) ' You got an error when using Ubound(myarray) so you created this to make the length determination the loop by creating a new variable call bound.
For i = 1 To bound
'ReDim Preserve myItems(1, i)
On Error Resume Next
Find_Spaces = WorksheetFunction.Find(" ", myItems(1, i))
If Err.Number = 1004 Then
Find_Spaces = 0
End If
Do
Length_of_myItems = Len(myItems(1, i))
Replace_Spaces = WorksheetFunction.Replace(myItems(1, i), Find_Spaces, 1, "_")
'MsgBox Replace_Spaces
'ReDim Preserve myItemsSpace(1, iSpace)
'myItemsSpace(1, iSpace) = Replace_Spaces
On Error Resume Next
'The Find() function will throw an error if it does not locatate the condition of the find - in this case a blank space, _
therefore you receive an error code 1004 indicatiing that the code sucessfully remove the space, so you told the code _
to set the variable Find_Space to zero if you received this error and jump to the next element in the array
Find_Spaces = WorksheetFunction.Find(" ", myItems(1, i))
If Err.Number = 1004 Then
Find_Spaces = 0
End If
If Find_Spaces > 0 Then
'ReDim Preserve myItems(1, i)
myItems(1, i) = Replace_Spaces
Else
myItems(1, i) = myItems(1, i)
End If
Loop While CBool(Find_Spaces) = True
'reverse this code to export the names of the tables out of the database by finding the underscores and replacing with spaces.
Next i
'END SECTION TO REMOVE SPACES SO SQL DOES NOT THROW ERROR
'THIS SECTION BUILDS THE SQL STRING
myItems2 = myItems
bound = UBound(myItems, 2)
' You got an error when using Ubound(myarray) so you created this to make the length determination the loop _
by creating a new variable call bound.
For i = 1 To bound
ReDim Preserve myItems2(1, i)
myItems2(1, i) = myItems(1, i) & " " & "Text" & ","
Next i
For Each c In myItems2
Cells(4, 1) = Cells(4, 1) & c
Next c
Cells(4, 1) = Trim(Cells(4, 1))
LastComma = Len(Cells(4, 1)) 'find the length of the string to drop last comma
Cells(4, 1) = Left(Cells(4, 1), LastComma - 1)
Cells(4, 1) = "CREATE TABLE" & " " & TableName _
& "(" & (Cells(4, 1)) & ")"
sqlstr = Cells(4, 1).Value ' I did this so I could inspect the SQL and copy it and past it directly into The MYSQL DB. Be sure to remove the contents if you rerun the macro.
'END SQL STRING BUILD
conn.Execute sqlstr ' Here is where the SQL string gets passed to the MYSQL DB
' Close connections
On Error Resume Next
rs.Close
Set rs = Nothing
conn.Close
End Sub
'THANK YOU FOR SHOPPING BlueBunny!!!*