Hi I keep getting an error when trying to upload to sql. The code have been working before, but I can find what I missed when rewriting the code..
it is falling at line:
cmd.CommandText = strSQL
the code is pretty simple it takes one column in a sheet and then upload or insert it in to an SQL database. please tell me what code I'm missing, or if I declare something wrong here
Dim cn As ADODB.Connection
Set sTroksheet = ThisWorkbook.Sheets("Mlist")
Set cn = New ADODB.Connection
Dim rs As New ADODB.Recordset
Dim strConn As String
Dim SQLstr As String
Dim SQLstrl As String
Dim Password As String
Dim Server_Name As String
Dim User_ID As String
Dim Database_Name As String
Dim Port_Name As String
Dim strTable As String
Dim excel_row As Long
Dim cmd As ADODB.Command
Dim rst_recordset As ADODB.Recordset
If ThisWorkbook.Sheets("Tournament Settings").Range("D4") = vbNullString
Then
MsgBox "Please setup database connection first in (DB Setup) in top menu"
Exit Sub
Else
Server_Name = Sheets("Software_Setup").Range("c3").Value
Database_Name = Sheets("Software_Setup").Range("c4").Value
User_ID = Sheets("Software_Setup").Range("c5").Value 'id user or username
Password = Sheets("Software_Setup").Range("c6").Value 'Password
Port_Name = Sheets("Software_Setup").Range("c7").Value 'Password
strConn = "Driver={MySQL ODBC 5.3 ANSI Driver};Server=" & _
Server_Name & ";Database=" & Database_Name & _
";Uid=" & User_ID & ";Pwd=" & Password & ";"
cn.Open strConn
LastRow = sTroksheet.Range("A65536").End(xlUp).row
strTable = Database_Name & ".TLHMember_List"
strSQL = "INSERT INTO " & strTable & _
" (Player) VALUES "
strSQL2 = ""
For excel_row = 1 To LastRow
strSQL2 = strSQL2 & _
"('" & sTroksheet.Cells(excel_row, 1) & "') ,"
Next excel_row
strSQL = strSQL & strSQL2
Mid(strSQL, Len(strSQL), 1) = ";" ' gets rid of the last comma
cmd.CommandText = strSQL
cmd.Execute
cn.Close
End If
You need to either change this line:
Dim cmd As ADODB.Command
to
Dim cmd As New ADODB.Command
or just before error line add new line:
Set cmd = new ADODB.Command
cmd.CommandText = strSQL
Related
Preparing the connection check to the SQL sever, which gives me below error if not in our group network its obsoletely fine but simple msgbox sufficient for me
enter image description here
Sub ADOExcelSQLServer()
Dim Cn As ADODB.connection
Dim server_name As String
Dim database_name As String
Dim User_ID As String
Dim Password As String
Dim SQLStr As String
Dim rs As ADODB.Recordset
Dim ws As Worksheet
Set rs = New ADODB.Recordset
Set ws = ActiveSheet
server_name = "192.168.x.xxx\SQLEXPRESS"
database_name = "ABC_System"
User_ID = "xx"
Password = "12345"
SQLStr = "SELECT * FROM dbo.Tbl_anb"
'SQLStr = "dbo.Tbl_wid"
Set Cn = New ADODB.connection
Cn.Open "Driver={SQL Server};Server=" & server_name & ";Database=" & database_name & _
";Uid=" & User_ID & ";Pwd=" & Password & ";"
If Cn.State = 1 Then
Debug.Print "Connected!"
MsgBox "Connected"
Else
MsgBox "Not Connected"
End If
Here is modified version with On error:
Dim Cn As ADODB.connection
Dim server_name As String
Dim database_name As String
Dim User_ID As String
Dim Password As String
Dim SQLStr As String
Dim rs As ADODB.Recordset
Dim ws As Worksheet
Set rs = New ADODB.Recordset
Set ws = ActiveSheet
server_name = "192.168.x.xxx\SQLEXPRESS"
database_name = "ABC_System"
User_ID = "xx"
Password = "12345"
SQLStr = "SELECT * FROM dbo.Tbl_anb"
'SQLStr = "dbo.Tbl_wid"
Set Cn = New ADODB.connection
On error resume next
Cn.Open "Driver={SQL Server};Server=" & server_name & ";Database=" & database_name & _
";Uid=" & User_ID & ";Pwd=" & Password & ";"
on error Goto 0
If Cn.State = 1 Then
Debug.Print "Connected!"
MsgBox "Connected"
Else
MsgBox "Not Connected"
end if
i do have ms.sql backend and ms.access frontend and always retrive the data shown in a form by following code:
Private Sub combo_search_Change()
Dim c As New ADODB.Connection
Dim rs As New ADODB.Recordset
Dim cmd As ADODB.Command
Dim Srv As Variant
Dim db As Variant
Dim UID As Variant
Dim pwd As Variant
Dim strSQL As String
Dim tbl_name As String
tbl_name = "tblSQLxxx"
Srv = CurrentDb.OpenRecordset("SELECT DISTINCT Server FROM [" & tbl_name & "]")(0)
'-------------------------------------------------------
db = CurrentDb.OpenRecordset("SELECT DISTINCT db FROM [" & tbl_name & "]")(0)
'-------------------------------------------------------
UID = CurrentDb.OpenRecordset("SELECT DISTINCT uid FROM [" & tbl_name & "]")(0)
'-------------------------------------------------------
pwd = CurrentDb.OpenRecordset("SELECT DISTINCT pwd FROM [" & tbl_name & "]")(0)
'---------------------------------------------------------------------------
c.ConnectionString = "Driver={SQL Server};Server=" & _
Trim([Srv]) & ";Database=" & Trim([db]) &""
and then calling with c.open & rs.open the needed data. as i have couple of list.boxes filled on the form, i place on each "on change" "exit" ... this above connection code and therefore flooding my code. is there a way to place the connection.code once in the form and then only call "c.open"&"rs.open" in all the "change/exit/entry" parts of the vba.code?
I am trying to extract data from SQL Server into Excel to populate a pre-existing worksheet so I wrote a test code to this this out. While it is imperfect what I was mainly testing was establishing the connection to the server but I run into an Automation error Error 440 when I open the connection. What am I doing wrong within that portion of code.
I haven't made any modifications as of yet and have check to make sure it compiled just fine.
Sub GetPhysicalCount()
Dim squery As String
Dim cnLogs As New ADODB.Connection
Dim rsData As New ADODB.Recordset
Dim rsHeaders As New ADODB.Recordset
Dim x As Long
Dim y As Long
Dim dbpath As String
Dim dbname As String
Dim AppExcel As Excel.Application
Dim Workbook As Object
Dim Worksheet As Object
Dim strConn As String
Dim Count As Long
pUser = "AllenBroady"
pPsw = "Cthulu90"
pServer = "IMCPU_TEST"
pCatalog = "MasterMFG"
strConn = "Provider = SQLOLEDB;"
strConn = strConn & "Initial Catalog= & pCatalog; & Data Source= & pServer;"
strConn = strConn & "Integrated Security=sspi;& User ID= & pUser; & Password= & pPsw;"
cnLogs.Open strConn
With rsHeaders
.ActiveConnection = cnLogs
.Open "SELECT * FROM MasterMFG WHERE Dept_Code = 001"
Do While Not rsHeaders.EOF
Cells(1, l_counter + 1) = rsHeaders(0)
l_counter = l_counter + 1
rsHeaders.MoveNext
Loop
.Close
End With
With rsCount
.ActiveConnection = cnLogs
.Open "SELECT COUNT(Dept_Code)FROM MasterMFG WHERE Total <> 0"
Count = rsCount
.Close
End With
With rsData
.ActiveConnection = cnLogs
.Open "SELECT Dept_Code, Total FROM MasterMFG WHERE Total <> 0"
For i = 1 To Count
Sheet1.Range("A" & i + 1) = rsData.Fields(i)
rsData.MoveNext
Sheet1.Range("B" & i + 1) = rsData.Fields(i)
Next i
.Close
End With
cnLogs.Close
Set cnLogs = Nothing
Set rsHeaders = Nothing
Set rsData = Nothing
Sheets(1).UsedRange.EntireColumn.AutoFit
End Sub
I keep getting an "Automation" error (Error 440)
Your strConn = strConn strings are not concatenated properly.
Your variables aren't evaluating, their names are just being put straight into the string.
Change, e.g.
strConn = strConn & "Initial Catalog= & pCatalog; & Data Source= & pServer;"
strConn = strConn & "Integrated Security=sspi;& UserID= & pUser; & Password= & pPsw;"
to
strConn = strConn & "Initial Catalog=" & pCatalog & ";Data Source=" & pServer & ";"
strConn = strConn & "Integrated Security=sspi;User ID= "& pUser; & "Password= " & pPsw & ";"
I have this Excel VBA code:
Sub ConnectSqlServer()
Dim conn As ADODB.Connection
Dim rs As ADODB.Recordset
Dim sConnString As String
Dim query As String
' Create the connection string.
sConnString = "Provider=SQLOLEDB;Data Source=xxxx.xxx.xxxx.xxx,xxxx;" & _
"Initial Catalog=mydb;" & _
"Trusted_Connection=yes;"
' Create the Connection and Recordset objects.
Set conn = New ADODB.Connection
Set rs = New ADODB.Recordset
' Open the connection and execute.
conn.Open sConnString
Set rs = conn.Execute("")
ActiveSheet.Range("A2").CopyFromRecordset rs
...
End Sub
all works fine.
The issue is in this section: Set rs = conn.Execute("")
My select statement query is just too big, split it into continuation lines is not practical.
Is there a way of reading the query text from a file, or from a variable?
Thank you very much
Sub ConnectSqlServer()
Dim conn As ADODB.Connection
Dim rs As ADODB.Recordset
Dim sConnString As String
Dim query As String
' Create the connection string.
sConnString = "Provider=SQLOLEDB;Data Source=xxxx.xxx.xxxx.xxx,xxxx;" & _
"Initial Catalog=mydb;" & _
"Trusted_Connection=yes;"
' Create the Connection and Recordset objects.
Set conn = New ADODB.Connection
Set rs = New ADODB.Recordset
' Open the connection and execute.
conn.Open sConnString
'read SQL from file
query = GetContent("C:\Stuff\myQuery.txt")
Set rs = conn.Execute(query)
ActiveSheet.Range("A2").CopyFromRecordset rs
...
End Sub
'read all file content
Function GetContent(f As String) As String
GetContent = CreateObject("scripting.filesystemobject"). _
opentextfile(f, 1).readall()
End Function
Alternatively, store your SQL in a worksheet cell and read it from there.
You don't have to use continuation lines, you can append the strings and append a vbCrLf character. e.g.
Dim sSQL as string
sSQL = "SELECT" & vbCrLf
sSQL = sSQL & "AField" & vbCrLf
sSQL = sSQL & ",BField" & vbCrLf
sSQL = sSQL & ",(SELECT XField FROM AnotherTable ..........) as XField" & vbCrlf
'and so on and so on
Set rs = conn.Execute(sSQL)
You can build very long SQL statements this way.
Sub LogCheck()
Dim cn As Object
Dim rs As Object
Dim StrSql As String
Dim strConnection As String
Dim AppPath As String
Set cn = CreateObject("ADODB.Connection")
AppPath = Application.ActiveWorkbook.Path
strConnection = "Provider=Microsoft.ACE.OLEDB.12.0;" & _
"Data Source=C:\ceo.accdb;"
cn.Open strConnection
S_ID = Sheets("My").Range("A1").Value
StrSql = "SELECT * FROM EDO Where ID = ' " & S_ID & " '"
rs.Open StrSql, cn
If rs = Null Then
MsgBox "Record Not found"
Else
MsgBox "Record Found"
End If
End Sub
I am unable to run this code. Its showing error. Please help me out. Thanks!
Here S_ID is the data which I would like to search from table & ID is the primary key in the EDO Table.
In this case you may detect if the recordset is empty checking .EOF property:
Sub TestIfRecordFound()
Dim strConnection As String
Dim strID As String
Dim strQuery As String
Dim objConnection As Object
Dim objRecordSet As Object
strConnection = _
"Provider=Microsoft.ACE.OLEDB.12.0;" & _
"Data Source='C:\ceo.accdb';"
strID = Sheets("My").Range("A1").Value
strQuery = _
"SELECT * FROM EDO WHERE ID = '" & strID & "';"
Set objConnection = CreateObject("ADODB.Connection")
objConnection.Open strConnection
Set objRecordSet = objConnection.Execute(strQuery)
If objRecordSet.EOF Then
MsgBox "Record Not found"
Else
MsgBox "Record Found"
End If
objConnection.Close
End Sub
If Id is numeric than the sql should be:
StrSql = "SELECT * FROM EDO WHERE Id = " & S_ID
You also did not define S_ID, so it will be handle as a variant here. If you still get an error, you might have to make it "& CStr(S_ID)".