I am having trouble running my sql code in a for loop. The code works for simple pasting the the sql code in one sheet but not when i put it in a loop. Does anyone have some experience in positing sql scripts in a for loop.
I need it to loop over my three sheets and paste the sql code in each sheet.
Sub rapport()
Dim ws_count As Integer
Dim i As Integer
Dim fundowner(3) As String
fundowner(1) = "110"
fundowner(2) = "120"
fundowner(3) = "130"
'fundowner(4) = "110"
'fundowner(5) = "110"
' Set variables
Dim con As ADODB.Connection
Dim rs_set As ADODB.Recordset
Dim sql As String
'Set Connection
Set rs_set = New ADODB.Recordset
Set con = New ADODB.Connection
con.ConnectionString = NPARRP_CONN_STRING
con.CursorLocation = adUseClient
con.Open
'Sheets("Ark1").Select
'Range("A9:I1000").ClearContents
'sql = Sheets("Ark1").Cells(1, 1).Value
sql = "Select port.FUND_OWNER, sum(fig.ASSETS)" & _
"from SCDDEX.NP_DM_FUND_FIGURES_V fig" & _
"inner join SCDDEX.NP_DM_FUND_PORTFOLIO_DEX port on fig.POR=PORT.POR" & _
"where port.FUND_OWNER in('130')" & _
"and DATE_FOR_FIGURES='2019-11-04'" & _
" group by port.FUND_OWNER"
ws_count = ActiveWorkbook.Worksheets.Count
For i = 1 To ws_count
If ActiveWorkbook.Worksheets(i).Cells(1, 1) = fundowner(i) Then
ActiveWorkbook.Worksheets(i).Cells(3, 1) = sql
Debug.Print sql
rs_set.Open sql, con
ActiveWorkbook.Worksheets(i).Cells(9.1).CopyFromRecordset rs_set
Else
MsgBox "Error"
End If
Next i
End Sub
You could change the Source string for the SQL connection on every iteration to output the recordset according to your fundownder value.
Keep in mind that by this approach, fundowner has be dimensioned according to the number of sheets in the workbook.
Also you will have to Close the recordset each time.
Sub rapport()
Dim ws_count As Integer
Dim i As Integer
Dim fundowner(1 To 3) As String
fundowner(1) = "110"
fundowner(2) = "120"
fundowner(3) = "130"
' Set variables
Dim con As ADODB.Connection
Dim rs_set As ADODB.Recordset
Dim sql As String
'Set Connection
Set rs_set = New ADODB.Recordset
Set con = New ADODB.Connection
con.ConnectionString = NPARRP_CONN_STRING
con.CursorLocation = adUseClient
con.Open
ws_count = ActiveWorkbook.Worksheets.Count
For i = 1 To ws_count
If ActiveWorkbook.Worksheets(i).Cells(1, 1) = fundowner(i) Then
ActiveWorkbook.Worksheets(i).Cells(3, 1) = sql
sql = "Select port.FUND_OWNER, sum(fig.ASSETS) " & _
"from SCDDEX.NP_DM_FUND_FIGURES_V fig " & _
"inner join SCDDEX.NP_DM_FUND_PORTFOLIO_DEX port on fig.POR=PORT.POR " & _
"where port.FUND_OWNER ='" & fundowner(i) & "') " & _
"and DATE_FOR_FIGURES='2019-11-04' " & _
"group by port.FUND_OWNER"
Debug.Print sql
rs_set.Open sql, con
ActiveWorkbook.Worksheets(i).Cells(9.1).CopyFromRecordset rs_set
rs_set.Close
Else
MsgBox "Error"
End If
Next i
End Sub
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.
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
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:
You set up the command, INSERT INTO ... VALUES (... 100 #parameter placeholders...)
You clear the parameters collection (in case VBA has decided to 'help' by creating them) and add a load of parameters that represent your strings in your sheet
You then iterate the sheet, row by row, setting each column value on the row, into the relevant parameter and after you set all the columns (100 times), you execute the command then move to the next row, set the values again and execute again (1000 times)
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
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.
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.
How to convert recordset to dataset because while 200 more data load to datagridview that after datagrid has been very slow, so i want my code change to load datagrid by dataset but i dont know dataset code how to merge multiple field of database data into one column in datagrid, So please help me...
Private Sub FLEX1_LOAD()
DataGridView1.Rows.Clear()
Dim strsql As String
Dim rs2 As ADODB.Recordset
strsql = "select * from voterlist where AREAID='" & Trim(lblAreaid.Text) & "'"
rs2 = New ADODB.Recordset
Call dbconnect2()
rs2.Open(strsql,conne2,ADODB.CursorTypeEnum.adOpenStatic,ADODB.LockTypeEnum.adLockPessimistic)
If rs2.RecordCount > 0 Then
rs2.MoveFirst()
For I = 0 To rs2.RecordCount - 1
DataGridView1.Rows.Add(1)
DataGridView1.Rows(J).Cells(0).Value = J + 1
DataGridView1.Rows(J).Cells(1).Value =rs2.Fields("ID").Value
DataGridView1.Rows(J).Cells(2).Value = rs2.Fields("NAM").Value & " " & rs2.Fields("SURNAME").Value & "/" & rs2.Fields("RTYPE").Value & "-" & rs2.Fields("RNAME").Value & " " & rs2.Fields("RSURNAME").Value
DataGridView1.Rows(J).Cells(3).Value = rs2.Fields("AGE").Value
J = J + 1
rs2.MoveNext()
Next
End If
rs2.Close()
rs2 = Nothing
conne2.Close()
End Sub
I have tables that are created each month to reflect that month's records. I have created vba code that runs a query in excel on multiple months to show changes, new adds, etc. However, I would like the user to be able to choose the two months they would like to compare from an excel drop down box. I am struggling to create dynamic SQL that can do this. Below is my attempted code
`Private Sub ADO_New()
Dim DBFullName As String
Dim Cnct As String, Src As String
Dim Connection As ADODB.Connection
Dim Recordset As ADODB.Recordset
Dim Col As Integer
Dim vCurrentMonth As Variant
Dim vPriorMonth As Variant
Dim wSummary As Worksheet
Set wSummary = Worksheets("Summary")
vCurrentMonth = wSummary.Range("Current_Month").Value
vPriorMonth = wSummary.Range("Prior_Month").Value
Worksheets("New").Cells.ClearContents
DBFullName = ThisWorkbook.Path & "\Guardian_CensusDB.accdb"
Set Connection = New ADODB.Connection
Cnct = "Provider=Microsoft.ACE.OLEDB.12.0;"
Cnct = Cnct & "Data Source=" & DBFullName & ";"
Connection.Open ConnectionString:=Cnct
Set Recordset = New ADODB.Recordset
With Recordset
Src = "SELECT * FROM [vCurrentMonth] LEFT JOIN [vPriorMonth] ON
[vCurrentMonth].[Plan Number] = [vPriorMonth].[Plan Number]" & _
"WHERE ((([vPriorMonth].[Plan Number]) Is Null))"
.Open Source:=Src, ActiveConnection:=Connection
For Col = 0 To Recordset.Fields.Count - 1
Sheets("New").Range("A1").Offset(0, Col).Value = _
Recordset.Fields(Col).Name
Next
Sheets("New").Range("A1").Offset(1, 0).CopyFromRecordset Recordset
End With
Set Recordset = Nothing
Connection.Close
Set Connection = Nothing
End Sub`
You need to concatenate the variables into your string:
Src = "SELECT * FROM [" & vCurrentMonth & "] LEFT JOIN [" & vPriorMonth & "] ON
[" & vCurrentMonth & "].[Plan Number] = [" & vPriorMonth & "].[Plan Number]" & _
"WHERE ((([" & vPriorMonth & "].[Plan Number]) Is Null))"
I have a local table in an MS Access 2010 database. I would like to use ADODB to load the local table into a Teradata environment within my spool space using CREATE VOLATILE TABLE command
This should be achievable i think using arrays but i was wondering is there a better way (speedy too if possible) to batch load the records into the teradata environment for example
CREATE VOLATILE TABLE EXAMPLE AS (SELECT * FROM LOCAL TABLE)
WITH DATA PRIMARY INDEX(Set Index Keys)
ON COMMIT PRESERVE ROWS;
Thanks for your help
Just a quick update on this [24/01/2013]
I have managed to get the data from the access database, Load it into an Array, Create a Volatile table in my teradata warehouse using spool space and then attempt to load the array into the table
I am getting the error: TEMP_TABLE already exists. when trying to append the records to the table
I am almost there so any help would be greatly appreciated. Thank you again for your help
Public Function Open_Connection()
On Error GoTo ErrorHandler
' http://voices.yahoo.com/teradata-ms-excel-vba-2687156.html
' The connection is used to connect with the DBMS,
' The Recordset to surf the result of some SELECT queries
' The Command to send the sql requests to Teradata.
Dim cn As ADODB.Connection
Set cn = New ADODB.Connection
Dim rs As ADODB.Recordset
Set rs = New ADODB.Recordset
Dim cmdSQLData As ADODB.Command
Set cmdSQLData = New ADODB.Command
Dim myArray() As Variant
' Open Connection With Teradata
cn.Open "Data Source=Database; " & _
"Database=Database; " & _
"Persist Security Info=True; " & _
"User ID=Me; " & _
"Password=FakePassword; " & _
"Session Mode=ANSI;"
' Which database it has to send the query
Set cmdSQLData.ActiveConnection = cn
' Query to create the violotile table in Teradata'
Query = "CREATE VOLATILE TABLE TEMP_TABLE ( " & _
"field1 VARCHAR (39)," & _
"field2 VARCHAR (44)," & _
"field3 DECIMAL (18, 3)," & _
"field4 CHAR (3))" & _
"ON COMMIT PRESERVE ROWS;"
' Query is assessed as Text
cmdSQLData.CommandText = Query
' Specifies which kind of command VBA has to execute
cmdSQLData.CommandType = adCmdText
' Remove Query Timeouts
cmdSQLData.CommandTimeout = 60
'VBA just run the query and send back the result
Set rs = cmdSQLData.Execute()
' Retrieve the sharepoint records into an Array
myArray = Retrieve_Sharepoint_Records
intNumberRows = UBound(myArray, 2) + 1 ' number of records/rows in the array
rowcounter = 0
' Append the Rows to the temp table
For rowcounter = 0 To intNumberRows - 1
' Debug.Print myArray(0, rowcounter) & " | " & myArray(1, rowcounter) & " | " & myArray(2, rowcounter) & " | " & myArray(3, rowcounter)
AppendQuery = "INSERT INTO TEMP_TABLE VALUES ('" & myArray(0, rowcounter) & "','" & myArray(1, rowcounter) & "'," & myArray(2, rowcounter) & ",'" & myArray(3, rowcounter) & "');"
cmdSQLData.CommandText = Query
cmdSQLData.CommandType = adCmdText
cmdSQLData.CommandTimeout = 60
Set rs = cmdSQLData.Execute()
Next
' Clean up
cn.Close
Set cn = Nothing
Set rs = Nothing
Set cmdSQLData = Nothing
ErrorHandler:
If (Len(Err.Description) > 0) Then
MsgBox (Err.Description)
End If
End Function
You may have better success using a Global Temporary Table as the object definition is stored within the DBC Data Dictionary on Teradata. The population of the table is session specific using the TEMPORARY space assigned to the user or the profile of the user.
Just to answer my own question, I should change the second code line of below
cmdSQLData.CommandText = Query
To
cmdSQLData.CommandText = AppendQuery
It then works perfectly albeit slowly
Again thank you all for your help