Reputation: 71
I promised myself I would not post this because I have this delusional thought that I am too good of a programmer, yet here we are.
I have altered what I posted earlier last week trying to figure out how to write a VBA function that would write data from an Excel Range to an MS SQL Table. That worked.
Towards the end of the program, I do not know how to construct the final execution of the code; I have tried everything from using the Command.Text
in the upper levels, setting it to a Recordset, then executing the recordset, but nothing will make the little VBA troll happy. Here is what I currently have written:
Sub Connection()
Dim Tbl As String
Dim InsertQuery As New ADODB.Command
InsertQuery.CommandType = adCmdText
Dim xlRow As Long, xlCol As Integer
Dim DBconnection As New ADODB.Connection
Dim ConnString As String
Dim rst As New ADODB.Recordset
Dim a As Integer, sFieldName As String
Dim db As DAO.Database
Dim CurrentDb As Database
Dim ConnectionStr
ConnectionStr = "Provider=sqloledb;Server="";Inital Catalog="";Integrated Security=SSPI;User ID="";Password="""
DBconnection.Open ConnectionStr
xlRow = 1 'only one row being used *as of now*, and that is the top row in the excel sheet
xlCol = 119 'First column of misc. data
While Cells(xlRow, xlCol) <> ""
If LH = True Then
Tbl = "Info.CaseBLH"
InsertQuery.CommandText = "INSERT INTO " & Tbl & " VALUES('"
ElseIf RH = True Then
Tbl = "Info.CaseBRH"
InsertQuery.CommandText = "INSERT INTO " & Tbl & " VALUES('"
Else
MsgBox ("No available sheets")
'Application.Quit
End If
NK21Data.TableDefs(Tbl).Fields.Count
For a = 1 To Fields.Count - 1
'For xlCol = 119 To 230 'columns DO1 to HV1
Fields.Item(a) = Replace(Cells(xlRow, xlCol), "'", "''") & "', '" 'Includes mitigation for apostrophes in the data
If Cells(xlRow, xlCol) = "" Then
rst.Fields.Item(a) = "NULL"
End If
xlCol = xlCol + 1
Next a
a = a + 1
Fields.Item(a) = (Format(Now(), "M/D/YYYY") & "')" & vbCrLf)
Wend
'On Error GoTo ErrorHandler
DBconnection.Execute (InsertQuery.CommandText)
DBconnection.Close
Set DBconnection = Nothing
ErrorHandler:
If Err.Number <> 0 Then
Msg = "Error # " & Str(Err.Number) & " was generated by " _
& Err.Source & Chr(13) & "Error Line: " & Erl & Chr(13) & Err.Description
MsgBox Msg, , "Error", Err.HelpFile, Err.HelpContext
End If
End Sub
The error I get is:
Command text was not set for the command object.
This error occurs at:
DBconnection.Execute (InsertQuery.CommandText)
If I try using the following:
InsertQuery = DBconnection.Execute
I will get the following error:
Argument not optional
I've been at this for about (give or take) three days and I'm now having nightmares about it so if someone can help me figure out what to do for this I would greatly appreciate it.
Upvotes: 1
Views: 6524
Reputation: 71
So I amended the code to the following:
Sub Connection()
Dim i As Integer, sqlIns As String, sqlVals As String
Dim InsertQuery As New ADODB.Command
Dim firstRow As Long, firstCol As Integer, lastCol As Integer, currRow As Integer
Dim DBconnection As New ADODB.Connection
Dim ConnString As String
Dim Tbl As String
ConnString = "Provider=sqloledb;Server=SERVER;Inital Catalog=DB;Integrated Security=SSPI;User ID=ID;Password=PW;"
DBconnection.Open ConnString
InsertQuery.ActiveConnection = DBconnection
InsertQuery.CommandType = adCmdText
If LH = True Then
Tbl = "Info.CaseBLH"
sqlIns = "INSERT INTO Info.CaseBLH("
ElseIf RH = True Then
Tbl = "Info.CaseBRH"
sqlIns = "INSERT INTO Info.CaseBRH("
Else
MsgBox ("No available sheets")
'Application.Quit
End If
''build the command text side by side, named columns and values with param placeholders
sqlVals = " VALUES("
''i could work these out by scanning the sheet i suppose. hardcoded for now
firstRow = 1
firstCol = 119
lastCol = 231
''generate the SQL - its this that lets the column names come in any order in the sheet
For i = firstCol To lastCol
sqlIns = sqlIns & Cells(firstRow, i) & ","
sqlVals = sqlVals & "?,"
InsertQuery.Parameters.Append InsertQuery.CreateParameter("p" & i - firstCol, adVarChar, adParamInput, 255)
Next i
''chop off the extra trailing commas and form a syntax correct command
InsertQuery.CommandText = Left$(sqlIns, Len(sqlIns) - 1) & ")" & Left$(sqlVals, Len(sqlVals) - 1) & ")"
''iterate the data part of the sheet and execute the query repeatedlty
currRow = firstRow ' - not needed as the data is automatically replaced with the code above
While Cells(currRow, firstCol) <> ""
For i = firstCol To lastCol - 1
InsertQuery.Parameters("p" & i - firstCol).Value = Cells(currRow, i)
Next i
InsertQuery.Execute , , adExecuteNoRecords ''dont return a resultset
Wend
DBconnection.Close
Set DBconnection = Nothing
ErrorHandler:
If Err.Number <> 0 Then
MsgBox Err.Description
End If
End Sub
Right at the
InsertQuery.Execute , , adExecuteNoRecords
Line I'm getting a error telling me there is a syntax error around the ':' which doesn't make any sense to me. If I append my code to send the error to the error handler, every single row it cycles through throws me an error saying there is a syntax error around '-' or '/'. I think it has something to do with the parameter.value line.
Upvotes: 0
Reputation: 74660
I fixed up and cleaned the code from my earlier answer, tested it to work:
Here's the code:
Option Explicit
Sub DoItThen()
Dim i As Integer, sqlIns As String, sqlVals As String
Dim InsertQuery As New ADODB.Command
Dim firstRow As Long, firstCol As Integer, lastCol As Integer, currRow As Integer
Dim DBconnection As New ADODB.Connection
Dim ConnString As String
ConnString = "Provider=SQLOLEDB.1;Integrated Security=SSPI;Persist Security Info=False;Initial Catalog=Example;Data Source=MYMACHINENAME"
DBconnection.Open ConnString
InsertQuery.ActiveConnection = DBconnection
InsertQuery.CommandType = adCmdText
''build the command text side by side, named columns and values with param placeholders
sqlIns = "INSERT INTO person("
sqlVals = " VALUES("
''i could work these out by scanning the sheet i suppose. hardcoded for now
firstRow = 2
firstCol = 3
lastCol = 5
''generate the SQL - its this that lets the column names come in any order in the sheet
For i = firstCol To lastCol
sqlIns = sqlIns & Cells(firstRow, i) & ","
sqlVals = sqlVals & "?,"
InsertQuery.Parameters.Append InsertQuery.CreateParameter("p" & i - firstCol, adVarChar, adParamInput, 255)
Next i
''chop off the extra trailing commas and form a syntax correct command
InsertQuery.CommandText = Left$(sqlIns, Len(sqlIns) - 1) & ")" & Left$(sqlVals, Len(sqlVals) - 1) & ")"
''iterate the data part of the sheet and execute the query repeatedlty
currRow = firstRow + 1
While Cells(currRow, firstCol) <> ""
For i = firstCol To lastCol
InsertQuery.Parameters("p" & i - firstCol).Value = Cells(currRow, i)
Next i
InsertQuery.Execute , , adExecuteNoRecords ''dont return a resultset
currRow = currRow + 1
Wend
DBconnection.Close
Set DBconnection = Nothing
ErrorHandler:
If Err.Number <> 0 Then
MsgBox Err.Description
End If
End Sub
It takes the first row as the names of the columns in the db table - any order is fine
It builds a command and populates the parameters
It repeatedly fills the values and executes the query, populating the table
Upvotes: 2
Reputation: 7117
Here is my basic ADODB Execute template. This isn't meant to be an answer but more a helpful post. It should assist in showing you what you're doing incorrectly, which appears to be simple syntax issues as well as being really new to this (formatting and other pieces of code suggest that maybe you've gotten yourself "googled into a corner.").
Private Sub ADODBExample()
Dim vbSql As String, cnnstr as string
Dim cnn As ADODB.Connection
vbSql = "sql statement ;"
Set cnn = New Connection
cnnstr = "Provider=SQLOLEDB;Data Source=SERVERNAME;Initial Catalog=DBNAME;User ID=USERID;Password=PASSWORD; Trusted_Connection=No"
cnn.Open cnnstr
cnn.Execute vbSql
cnn.Close
Set cnn = Nothing
End Sub
More helpful tips -
Stop looping through cells, ranges and other worksheet/book objects. Learn to use arrays - itll make processing way better.
Simplicity is best. You appear to doing what I consider alot of unnecessary things, but then again I dont know all the requirements.
Upvotes: 1
Reputation: 74660
OK; don't shoot me - I'm no VBA whizz but I'm saying you should strive to make your code more like this:
Sub DoItThen()
Dim a As Integer, sql as String
Dim InsertQuery As New ADODB.Command
Dim xlRow As Long, xlCol As Integer
Dim DBconnection As New ADODB.Connection
Dim ConnString As String
ConnString = "Provider=sqloledb;Server="";Inital Catalog="";Integrated Security=SSPI;User ID="";Password="""
DBconnection.Open ConnString
InsertQuery.ActiveConnection = conn
InsertQuery.CommandType = adCmdText
If LH = True Then
sql = "INSERT INTO Info.CaseBLH VALUES(@p1"
ElseIf RH = True Then
sql = "INSERT INTO Info.CaseBRH VALUES(@p1"
Else
MsgBox ("No available sheets")
'Application.Quit
End If
''does this do anything? I don't know
NK21Data.TableDefs(Tbl).Fields.Count
''let us add some placeholders to the command: we add count-2 because we already have one ? in the command
''ps; don't know where you got fields.count from
For a = 2 To Fields.Count - 1
sql = sql & ",@p" & a
Next a
''finish off our command
InsertQuery.CommandText = sql & ")"
''now we have a command like INSERT INTO tbl VALUES(@p1, @p2, @p3.."
''and setting the command text might pre-populate the parameters collection
''with the same number of parameters as are in the command, so let's clear it and
''add the parameters again ourselves so we can control the type
InsertQuery.Parameters.Clear
''create a load of parameters
For a = 1 To Fields.Count - 1
InsertQuery.Parameters.Append InsertQuery.CreateParameter("@p" & a, adVarChar, adParamInput, 255) 'adjust if you have strings longer than 255
Next a
''Now all the parameters are set etc, we just go through all the rows,
''and all the columns and set the values, then execute the command, then change the values and execute again
''--> set the command up once and repeatedly execute it
xlRow = 1 'only one row being used *as of now*, and that is the top row in the excel sheet
xlCol = 119 'First column of misc. data
While Cells(xlRow, xlCol) <> ""
For a = 1 To Fields.Count - 1
InsertQuery.Parameters("@p" & a).Value = Cells(xlRow, xlCol + a)
Next a
InsertQuery.Execute , , adExecuteNoRecords ''dont return a resultset
Wend
DBconnection.Close
Set DBconnection = Nothing
ErrorHandler:
If Err.Number <> 0 Then
Msg = "Error # " & Str(Err.Number) & " was generated by " _
& Err.Source & Chr(13) & "Error Line: " & Erl & Chr(13) & Err.Description
MsgBox Msg, , "Error", Err.HelpFile, Err.HelpContext
End If
End Sub
You have 100 columns and 1000 rows to insert from an excel sheet:
I've got absolutely no way of testing this, sorry - it's my best guess but I fully expect it still has some error because I don't really know where you got Fields
from. The answer with 8 votes from here was helpful: VBA, ADO.Connection and query parameters - I distinctly recall from when I was using VB6 about 20 years ago, that ADODB would try and prepopulate the parameters collection in certain circumstances, with its guesses at the parameter types; we routinely cleared it and added our own, but you might have some success proceeding with the default parameters it makes
The names of the parameters are not relevant; only the position. There's no requirement that @p1 from the query string matches the @p1 name given for the parameter - if the first parameter in the string were called @bob and you then cleared and added a parameter named @alice, whatever @alice's value was would be assigned to @bob because @bob is first in the query and @alice is first in the parameters collection. I used @pXXX as a parameter name for ease of reference in both cases
Upvotes: 1