I have a really weird issue with my Excel VBA code selecting values from a MySQL database. I structured a simple database with following columns:
ID
Name
Surname
City
And lets assume having following entrys:
01; Pan; Peter; NYC
02; P; Peter; NYC
But now the issue, if I select * from my table it shows me only following output:
01; P; Pan; NYC
02; P; Pan; NYC
That means the I only see the minimal lenght of an entry .... what is going on there? I have really casual VBA code in different modules for that task:
Public variables:
Public cn As ADODB.Connection
Public rs As ADODB.Recordset
Public strSql As String
Connection module:
Public Function connectDB()
Dim strServer_Name As String
Dim strDB_Name As String
Dim strUser_ID As String
Dim strPassword As String
With Sheet2
strServer_Name = .Range("B2").Value
strDB_Name = .Range("B3").Value
strUser_ID = .Range("B4").Value
strPassword = .Range("B5").Value
End With
Set cn = New ADODB.Connection
cn.Open "DRIVER={MySQL ODBC 5.3 Unicode Driver}" & _
";SERVER=" & strServer_Name & _
";DATABASE=" & strDB_Name & _
";UID=" & strUser_ID & _
";PWD=" & strPassword & ""
End Function
Sub module:
Sub request()
strSql = "SELECT * FROM test"
Call connectDB
Set rs = New ADODB.Recordset
rs.Open strSql, cn, adOpenDynamic
With Sheet1.Range("A1")
.ClearContents
.CopyFromRecordset rs
End With
Call disconnectDB
End Sub
Is this a VBA issue or are there any bugs in my MySQL?
Okay guys I've found a solution in this post: sql-query-doesnt-return-full-results-for-only-one-field
Solved it the same way the other guy did. In my code it looks like this:
Sub request()
Dim iCols As Integer
Dim iRows As Integer
strSql = "SELECT * FROM test"
Call connectDB
Set rs = New ADODB.Recordset
rs.Open strSql, cn, adOpenDynamic
iRows = 10
While Not rs.EOF
For iCols = 0 To rs.Fields.Count - 1
Tabelle1.Cells(iRows, iCols + 1).Value = rs.Fields(iCols).Value
Next
rs.MoveNext
iRows = iRows + 1
Wend
Call disconnectDB
End Sub
But thanks to everyone who tried to help me!
Related
Getting this error all time:
Run-time error '13': Type mismatch.
On this line
rs.Open , sqlstr, conn
I tried everything and can't solve the problem. I'm trying to update one row in MySQL database.
Private Sub CommandButton3_Click()
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 i As Long
Dim sqlstr As String
Dim table1 As String, table2 As String
Dim field1 As String, field2 As String
Dim rs As ADODB.Recordset
Dim vtype As Variant
server_name = "99.99.99.99"
database_name = "name"
user_id = "user"
password = "pass"
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"
Set rs = New ADODB.Recordset
sqlstr = "SET SQL_SAFE_UPDATES = 0; UPDATE table SET poslano = 'Poslano' WHERE poslano = 'Neposlano';"
rs.Open , sqlstr, conn
With Worksheets("List6").Cells("A1")
.ClearContents
.CopyFromRecordset rs
End With
skipextract:
On Error Resume Next
rs.Close
Set rs = Nothing
conn.Close
Set conn = Nothing
On Error GoTo 0
End Sub
The comma after rs.Open makes VBA "think" that the Source is omitted:
Thus, it gives Type mismatch error. Try to write it like this:
rs.Open sqlstr, conn
Please find the below table and code. I am facing Invalid use of Null Error
Table 1
Table 2
VBA code:-
Sub sql()
sql_string = "Select [Sheet1$].[Sr], [Sheet2$].[Name], [Sheet2$].[Value] From [Sheet1$]" & _
" Inner Join [Sheet2$] On CInt([Sheet1$].[Sr]) = CInt(Mid([Sheet2$].[Name],InStr(1,[Sheet2$].[Name],""#"")+1))"
sq = SQL_query(sql_string)
end sub
Function SQL_query(ByRef sql_string As Variant)
Dim cn As ADODB.Connection
Dim rs As ADODB.Recordset
strFile = ThisWorkbook.FullName
strCon = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & strFile _
& ";Extended Properties=""Excel 12.0;HDR=Yes;IMEX=1"";"
Set cn = CreateObject("ADODB.Connection")
Set rs = CreateObject("ADODB.Recordset")
cn.Open strCon
strSQL = sql_string
rs.Open strSQL, cn
Sheet5.Range("A21").CopyFromRecordset rs ''HERE I AM FACING ERROR
End Function
Please guide me.. on my below error.
In table2 column Sr after # there are some number's which is similar to table1 column Sr number's.I want to do inner join as per that particular number.
required output.
Start by writing Option Explicit on top of the module. Why does my code run without 'Option Explicit' but fail with it?
Then change the Sub sql() to something like this:
Function sql_string() as string
sql_string = "Select [Sheet1$].[Sr], [Sheet2$].[Name], [Sheet2$].[Value] From [Sheet1$]" & _
" Inner Join [Sheet2$] On CInt([Sheet1$].[Sr]) = CInt(Mid([Sheet2$].[Name],InStr(1,[Sheet2$].[Name],""#"")+1))"
end sub
In the immediate window, write ?sql_string and see what you get.
Find a way to test what you get
I Have created a ODBC DSN to MySQL called "TEST". The table in the MySQL Database is Called "DETAILS" and the columns are called:
ID (Auto Number) | NAME | SURNAME | DATE|
In Excel, I have a userform with the following controls: Textbox1 = NAME, Textbox2 = SURNAME and DTPicker = DATE + a Command Button Called SAVE.
Is there a way that I can save this data directly to the MySQL Database by pushing the command button? I have the ODBC DSN connection to access the database
UPDATE
This is the code I Have:
Private Sub CommandButton1_Click()
Dim cn As ADODB.Connection
Dim rs As ADODB.Recordset
strCon = "Driver={MySQL ODBC 5.1 Driver};SERVER=SERVERNAME;DATABASE=DATABASE;UID=USERID;PWD=PASSWORD"
Set cn = CreateObject("ADODB.Connection")
cn.Open strCon
Set rs = CreateObject("adodb.recordset")
rs.Open "INSERT INTO MYTABLE (ID, Name, Surname, Date) VALUES (Textbox1.Value, Textbox2.value, DTPicker1.Value)", cn
rs.Close
End Sub
But It doesn't allow me to reference the CONTROLS, Textboxes and DTPicker
Give this a shot:
Private Sub CommandButton1_Click()
Dim cn As ADODB.Connection
Dim rs As ADODB.Recordset
strCon = "Driver={MySQL ODBC 5.1 Driver};SERVER=SERVERNAME;DATABASE=DATABASE;UID=USERID;PWD=PASSWORD"
Set cn = CreateObject("ADODB.Connection")
cn.Open strCon
Set rs = CreateObject("adodb.recordset")
rs.Open "INSERT INTO MYTABLE (Name, Surname, Date)" _
" VALUES (" & Textbox1.Value & ", " & Textbox2.value _
", " & DTPicker1.Value &")", cn
rs.Close
End Sub
Here is the Code to Make this work:
Private Sub CommandButton1_Click()
Dim c As ADODB.Connection
Dim r As ADODB.Recordset
Set c = New ADODB.Connection
Dim rw As Integer
c.Open "DSN=DSNName"
sq = "Insert into MYTABLE (NAME, SURNAME, DATE) values ('" & TextBox1.Value & "','" & TextBox2.Value & "','" & DTPicker1.Value & "')" Set r = c.Execute(sq)
c.Close
End Sub
So, I have to write a piece of code at my internship to link some excel worksheets with a MySQL DB and keep them updated, so far I have this but it keeps giving me errors. Do you see any mistakes?
Thanks for reading.
The error I get is: runtime error -2147217900 automation error.
PS: I'm very new to VBA
Dim server_name As String
Dim database_name As String
Dim user As String
Dim Password As String
Dim rs As adodb.Recordset
Dim naam As String
Dim oConn As adodb.Connection
Public Sub getSerieNummer()
Dim result As String
Dim b As Long
Dim strSQL As String
naam = Range("C1").Value
server_name = "servername"
database_name = "dbname"
user_id = "idname"
Password = "password"
Set oConn = New adodb.Connection
oConn.Open "SERVER=" & server_name _
& ";PORT=3306" _
& ";DATABASE=" & database_name _
& ";UID=" & user_id _
& ";PWD=" & Password & _
";DSN=name_in_odbc;"
strSQL = "SELECT [serial_number] FROM view_aix WHERE [name] ='" & naam & "';"
Set rs = oConn.Execute(strSQL)
b = 0
With rs
Do Until .EOF
b = b + 1
result = !serial_number
rs.MoveNext
Loop
End With
oConn.Close
rs.Close
Set rs.ActiveConnection = Nothing
Set oConn = Nothing
Range("C2").Value = result
End Sub
MySQL do not support "[" instead use " ` ".
Maybe is your connection string the problem.
ODBC Connection Style
Driver={mySQL};Server=localhost;Option=16834;Database=myDataBase;
OLEDB Connection Style
Provider=MySQLProv;Data Source=mydb;User Id=myUsername;Password=myPassword;
My requirement: To search for data in database, using VB forms and 3 text boxes.
1 TextBox, I will give Input (UserName)
1 TextBox for Location
1 TextBox for displaying output
My code is
Private Sub CommandButton3_Click()
Dim Cn As ADODB.Connection '* Connection String
Dim oCm As ADODB.Command '* Command Object
Dim sName As String
Dim rs As ADODB.Recordset
Dim uname As String
Set Cn = New ADODB.Connection
Cn.ConnectionString = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=d:\test2.accdb;Persist Security Info=False"
Cn.ConnectionTimeout = 40
Cn.Open
Set oCm = New ADODB.Command
oCm.ActiveConnection = Cn
‘Record Set
Set rs = New ADODB.Recordset
‘Select Operation
rs.Open "SampleTable", Cn, adOpenKeyset, adLockPessimistic, adCmdTable
uname = rs("UserName")
rs.Open "Select * from SampleTable where uname = '" & text1.Text & "'", ActiveConnection, adOpenForwardOnly, adLockReadOnly, adCmdText
**'Display the Output in TextBox3**
TextBox3.Text = rs("UserName") + rs("Location")
rs.Close
Cn.Close
End Sub
I can understand the population of data is not happening so getting a RunTime error 424 at Select statement. How can I retrieve the data for the corresponding Input given?
You do not need to open the table; rs.Open "SampleTable" before searching it.
Not sure what this is for; uname = rs("UserName")
You should just run; rs.Open "Select * ... (Running the .Open on the same RS twice without closing the first is probably whats causing your error)
You should escape your input; replace$(text1.Text, "'", "''")
You should check for rs.EOF after the .open
Use & not + for concatenating strings
update
sub xxx
Dim Cn As ADODB.Connection
Dim rs As ADODB.Recordset
Dim sName As String
Set Cn = New ADODB.Connection
Cn.ConnectionString = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=d:\test2.accdb;Persist Security Info=False"
Cn.ConnectionTimeout = 40
Cn.Open
Set rs = New ADODB.Recordset
sName = replace$(text1.Text, "'", "''")
rs.Open "Select * from SampleTable where UserName = '" & sName & "'", Cn, adOpenForwardOnly, adLockReadOnly, adCmdText
if (rs.eof) then
msgbox "no match"
else
TextBox3.Text = rs("UserName") & " " & rs("Location")
rs.Close
end if
set rs = nothing
Cn.Close
set cn = nothing
end sub