VBA Update sql from Excel to MS SQL Server 2008 using ListColumns - vba

I am working on an Excel 2010 Workboox where a macro pulls in data from a database table. The users can then update the values of Column06) to a specific value if needed. Once complete, they can run a macro to run a SQL update so Column06 in the database is updated where COLUMN01 and COLUMN02 are in the database table. I know the ADO connection is working as I tried with a very generic sql which worked fine. I know that the table could be of varying lengths, so I knew I probably needed to loop through the rows, and that's where I'm stuck.
I tried setting up a loop similar to another solution I found online, and started getting Run-Time Error 91 "Object variable or with block variable not set". I think is due to the ListObject.ListColumns I'm using in the new Update Statement. I've tried using other examples to declare these, but it usually ends up in other errors. I must be missing something, or doing something wrong. Any help would be greatly appreciated.
Sub Updatetbl_data()
'
' Updatetbl_data Macro
' test
Sheets("Sheet2").Select
Dim cnn As ADODB.Connection
Dim uSQL As String
Set cnn = New Connection
cnnstr = "Provider=SQLOLEDB; " & _
"Data Source=MySource; " & _
"Initial Catalog=MyDB;" & _
"User ID=ID;" & _
"Password=Pass;" & _
"Trusted_Connection=No"
cnn.Open cnnstr
' New Update Statement idea based on possible solution found online
Dim row As Range
For Each row In [tbl_data].Rows
uSQL = "UPDATE tbl_data SET Column06 = '" & (row.Columns (row.ListObject.ListColumns("Column06").Index).Value) & _
"' WHERE Column01 = '" & (row.Columns(row.ListObject.ListColumns ("Column01").Index).Value) & _
"' AND Column02 = '" & (row.Columns(row.ListObject.ListColumns("Column02").Index).Value) & "' "
'Debug.Print (uSQL)
cnn.Execute uSQL
Next
cnn.Close
Set cnn = Nothing
Exit Sub
'
End Sub

Perhaps row.Columns is not designed for what you want to achieve. You can give this link to another article on stackoverflow a look for some more information. Next, I made some changes to your code which might do the trick.
' ... ... ...
Dim row As Range
'For Each row In [tbl_data].Rows ==>> has to be replaced by
'For Each row In [tbl_data] ==>> which returns all cells, perhaps better the following
Const ColNbr_Column01 As Long = 1
Const ColNbr_Column02 As Long = 2
Const ColNbr_Column06 As Long = 6
' now, select only the first column of the range [tbl_data]
For Each row In Range( _
[tbl_data].Cells(1, 1).Address, _
[tbl_data].Cells([tbl_data].Rows.Count, 1).Address)
' now, use offset to reach to the columns in the row
uSQL = "UPDATE tbl_data SET Column06 = '" & row.Offset(0, ColNbr_Column06).Value & _
"' WHERE Column01 = '" & row.Offset(0, ColNbr_Column01).Value & _
"' AND Column02 = '" & row.Offset(0, ColNbr_Column02).Value & "' "
'Debug.Print (uSQL)
' ... ... ...

This is the basic concept.
Sub InsertInto()
'Declare some variables
Dim cnn As adodb.Connection
Dim cmd As adodb.Command
Dim strSQL As String
'Create a new Connection object
Set cnn = New adodb.Connection
'Set the connection string
cnn.ConnectionString = "Provider=SQLOLEDB.1;Integrated Security=SSPI;Persist Security Info=True;Initial Catalog=Database;Data Source=Server_Name"
'Create a new Command object
Set cmd = New adodb.Command
'Open the Connection to the database
cnn.Open
'Associate the command with the connection
cmd.ActiveConnection = cnn
'Tell the Command we are giving it a bit of SQL to run, not a stored procedure
cmd.CommandType = adCmdText
'Create the SQL
strSQL = "UPDATE TBL SET JOIN_DT = '2017-10-08' WHERE EMPID = 1"
'Pass the SQL to the Command object
cmd.CommandText = strSQL
'Execute the bit of SQL to update the database
cmd.Execute
'Close the connection again
cnn.Close
'Remove the objects
Set cmd = Nothing
Set cnn = Nothing
End Sub

Related

Where oh Where (VBA SQL Where Clause with Variable)

I am SQL guy trying to help with a VBA project. I get a VBA error when I try to run this sql statement. Run-time error '-2147217913 (80040e07)' Automation error.
I can send a number without issue so I know I am doing something wrong when a string is passed. Thank you for your help! I have spent so much time trying to figure it out.
sSQLSting = "SELECT TOP 10 PctTtlAssets, Port_Code FROM [db_detail$]
WHERE Port_Code = ' " & [vbaThisPort] & " ' "
which looks like this when saved to my variable.
sSQLSting = "SELECT TOP 10 PctTtlAssets, Port_Code FROM [db_detail$]
WHERE Port_Code = 'salmemhs' "
Thank you
PS
Here is the full code the vba guy is using. Again, works fine until I send a string.
Sub sbADO()
Dim sSQLQry As String
Dim ReturnArray
Dim Conn As New ADODB.Connection
Dim mrs As New ADODB.Recordset
Dim DBPath As String, sconnect As String, vbaThisPort As String
vbaThisPort = Trim(ThisWorkbook.Names("ThisPort").RefersToRange(1, 1))
'MsgBox (vbaThisPort) 'Testing
DBPath = ThisWorkbook.FullName
'You can provide the full path of your external file as shown below
'DBPath ="C:\InputData.xlsx"
sconnect = "Provider=MSDASQL.1;DSN=Excel Files;DBQ=" & DBPath & ";HDR=Yes';"
' Your SQL Statemnt (Table Name= Sheet Name=[DataSheet$])"
Conn.Open sconnect
sSQLSting = "SELECT TOP 10 PctTtlAssets, Port_Code FROM [db_detail$] WHERE Port_Code = '" & [vbaThisPort] & "'"
mrs.Open sSQLSting, Conn
'=>Load the Data into an array
'ReturnArray = mrs.GetRows
''OR''
'=>Paste the data into a sheet
ActiveSheet.Range("A2").CopyFromRecordset mrs
'Close Recordset
mrs.Close
'Close Connection
Conn.Close
End Sub

Executing SQL query stored in an excel cell and then transfer the result set into a .txt file

I have a SQL query stored in one of my excel sheet cells that I execute using the below VBA Code:
Sub run()
Dim dtStart As Date
Dim dtEnd As Date
Dim MRC As Variant
'Get the SQL text(s)
MRC = "" & Worksheets("SQL Text").Range("D4").Value & ""
'Check for UNDF queries
If MRC = 0 Then
MsgBox ("Query has not yet been defined, please make a new selection")
Exit Sub
Else
End If
'Set up query
Application.StatusBar = "Data Refresh: 1 of 1 "
'Update subTabs
Sheets("Summary").Select
With ActiveWorkbook.Connections("connection1").OLEDBConnection
.CommandText = MRC
.CommandType = xlCmdSql
End With
ActiveWorkbook.Connections("connection1").Refresh
End Sub
In addition to the above VBA code, I also have another VBA code that executes the different SQL view and transfers the SQL view result-set to a .txt file and saves it into a specific folder. Please see below for that code
Sub TEXT()
Dim cn As New ADODB.Connection
Dim rs As New ADODB.Recordset
Dim strCon, strSQL As String
strCon = "Provider=SQLOLEDB.1;" & _
"Integrated Security=SSPI;Persist Security Info=True;" & _
"Initial Catalog=master;Data Source=VRSQLADHOC;" & _
"Use Procedure for Prepare=1;" & _
"Auto Translate=True;" & _
"Packet Size=4096;" & _
"Use Encryption for Data=False;" & _
"Tag with column collation when possible=False"
strSQL = "SELECT * FROM table1" 'Sql Query
Folder = "U:\" 'Path in U drive
Filename = "file_name_" & Format(Now(), "YYYYMMDD") & ".txt" 'Name of Text document
fpath = Folder & Filename
cn.Open strCon
rs.ActiveConnection = cn
rs.Open strSQL
Set fs = CreateObject("Scripting.FileSystemObject")
Set A = fs.CreateTextFile(fpath)
A.Write (rs.GetString(adClipString, , , vbCrLf, ""))
rs.Close
cn.Close
Set cn = Nothing
MsgBox ("file name " + fpath)
End Sub
Currently I am interested in applying the second VBA logic of transferring the result-set data into .txt file to my first VBA logic, which takes care of executing the SQL query stored in one of the excel sheet cells.
To put it shortly I want to execute a SQL query stored in an excel cell and then transfer the result set into a .txt file
If I'm understanding this right, both these subs use really different ways do query the database.
In the first example you've got a db connection in a sheet, and you're using a cell to update that connection.
In the second, you've got a vba /adodb connection to the database. If all you want to do is refer to a cell in excel for the query, then simply change the line:
strSQL = "SELECT * FROM table1" 'Sql Query
to something more like:
strSQL = Worksheets("SQL Text").Range("D4").Value

Need help creating temporary table using ADO from VBA

I've searched pretty extensively and found a lot of topics on this which helped me get my code to the point it is, but I'm at an impasse as I'm not sure what I'm doing wrong here.
I'm trying to create a temporary table so that I can pull info from a couple of other tables, drop it in, then push it out to excel.
Right now I was just trying to create a recordset from the temporary table to check that it is being created, and I'm getting an error on the select * from temporary table line.
The error I'm getting is: error -2147217865 (800040e37) Invalid object name '#TempGetBOM'
The database platform is MS SQL Server.
EDIT:
I updated the code to insert some data into the table to see if that would give me the object doesn't exist error. It executed without error, so that would indicate it exists. Then, while stepping through the code, I tried to execute the "create table" statement again, and it did error telling me the object already exists.
One thing I also found is after I create the table, if I step back in the code and run the line to check if the table exists and drop it, when I get to the create table line after that, it still says the table exits. So obviously that check and drop if exists statement is not working as I intended.
Updated code:
'Declare variables
Dim strSQL As String
Dim strConBase As String
Dim ADOcon As ADODB.Connection
Dim ADOrsetA As ADODB.Recordset
Dim ADOcmA As ADODB.Command
'Initialize objects
Set ADOcon = New ADODB.Connection
Set ADOrsetA = New ADODB.Recordset
Set ADOcmA = New ADODB.Command
'Ensure clean exit if there is an error
'On Error GoTo CleanExit
'Open Connections
strConBase = strConDriver & strConServer & strConApp & "WSID=" & Environ$("COMPUTERNAME") & ";" & strConDbTest & strConNetwork & strConTConn
ADOcon.ConnectionString = strConBase
ADOcon.Open
'Open Recordsets for item
strSQL = "SELECT '" & strItem & "'," & strTblItem & ".Item_desc_1," & strTblItem & ".Item_desc_2 FROM " & strTblItem & " WHERE Item_no ='" & strItem & "'"
Set ADOrsetA.ActiveConnection = ADOcon
ADOrsetA.Open strSQL
'Create a temporary table to handle the intermediary work between item and BOM recordsets
With ADOcmA
Set .ActiveConnection = ADOcon
.CommandType = adCmdText
.CommandText = "IF OBJECT_ID('#MyTempGetBOM') IS NOT NULL DROP TABLE #MyTempGetBOM"
.Execute
.CommandText = "CREATE TABLE #MyTempGetBOM (ITEM VARCHAR(255),DESCRIP1 CHAR(255),DESCRIP2 CHAR(255), LEV INT, SEQ INT, FLAG1 CHAR(255), PRIMARYKEY INT IDENTITY(1,1) PRIMARY KEY,QTY_PER NUMERIC)"
.Execute
.CommandText = "Insert Into #MyTempGetBOM (ITEM,DESCRIP1,DESCRIP2,LEV,SEQ,FLAG1,QTY_PER) select '" & strItem & "',Item_desc_1,Item_desc_2,1,'1','o',1 FROM " & strTblItem
.Execute
End With
Dim ADOrsetB As ADODB.Recordset
Set ADOrsetB = New ADODB.Recordset
strSQL = "SELECT * FROM #MyTempGetBOM"
Set ADOrsetB.ActiveConnection = ADOcon
ADOrsetB.Open strSQL
So, I got it working by changing the table name from #TempBom to MyTempBom.
Not sure what the # is, I saw it used in some code I was trying to emulate.
Obviously, I have very little experience in SQL.
OK, so after some more reading and searching, I decided to try a different approach to setting the recordset using the command object I created. This worked.
I guess I don't understand the MS SQL object model well enough, but I thought the temporary table would be tied to the connection object, so that as long as I was using the same connection I could access it. But it appears to me it's actually tied to the command object. Is that right?
Anyways, here is the updated code that is mostly working (the drop table if object not null statement still doesn't do what I expected). I'm sure it could be done in a better/simpler/more efficient way, but this is where I've gotten so far.
'Declare variables
Dim strSQL As String
Dim strConBase As String
Dim ADOcon As ADODB.Connection
Dim ADOrsetA As ADODB.Recordset
Dim ADOcmA As ADODB.Command
Dim ADOrsetB As ADODB.Recordset
'Initialize objects
Set ADOcon = New ADODB.Connection
Set ADOrsetA = New ADODB.Recordset
Set ADOcmA = New ADODB.Command
Set ADOrsetB = New ADODB.Recordset
'Ensure clean exit if there is an error
'On Error GoTo CleanExit
'Open Connections
strConBase = strConDriver & strConServer & strConApp & "WSID=" & Environ$("COMPUTERNAME") & ";" & strConDbTest & strConNetwork & strConTConn
ADOcon.ConnectionString = strConBase
ADOcon.Open
'Open Recordsets for item
strSQL = "SELECT '" & strItem & "'," & strTblItem & ".Item_desc_1," & strTblItem & ".Item_desc_2 FROM " & strTblItem & " WHERE Item_no ='" & strItem & "'"
Set ADOrsetA.ActiveConnection = ADOcon
ADOrsetA.Open strSQL
'Create a temporary table to handle the intermediary work between item and BOM recordsets
Set ADOrsetB.ActiveConnection = ADOcon
With ADOcmA
Set .ActiveConnection = ADOcon
.CommandType = adCmdText
.CommandText = "IF OBJECT_ID('#MyTempGetBOM') IS NOT NULL DROP TABLE #MyTempGetBOM"
.Execute
.CommandText = "CREATE TABLE #MyTempGetBOM (ITEM VARCHAR(255),DESCRIP1 CHAR(255),DESCRIP2 CHAR(255), LEV INT, SEQ INT, FLAG1 CHAR(255), PRIMARYKEY INT IDENTITY(1,1) PRIMARY KEY,QTY_PER NUMERIC)"
.Execute
.CommandText = "Insert Into #MyTempGetBOM (ITEM,DESCRIP1,DESCRIP2,LEV,SEQ,FLAG1,QTY_PER) select '" & strItem & "',Item_desc_1,Item_desc_2,1,'1','o',1 FROM " & strTblItem
.Execute
.CommandText = "SELECT * FROM #MyTempGetBOM"
Set ADOrsetB = .Execute
End With
Your problem is that the SQL Server session your temporary table is created in is terminated when your procedure completes.

Uploading Volatile Table using VBA

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

Access VBA query to SQL Server

Hello experts I'm having trouble in my update query from SQL Server. Running first a select query then pass the result to currentdb.execute (to update the table of the access file currently using), using Access vba I'm not doing it right. I really hope you could help me. Maybe you guys know much better way to run my procedure:
connect to sql server 2008, run select query.
pass the result of select query to an access database execute command (or if you have a better idea) to update a table in the current access file that is using.
The error I'm getting to the code is Type mismatch and highlighting .OpenSchema.
These is part of the code that I made wrong (and I really have no idea how to do this).
dbObj.Execute ("UPDATE ACCESS.tbl_Name RIGHT JOIN " & _
conn.OpenSchema(adSchemaTables, Array(Empty, Empty, Empty, "SQLSVR.tbl_Name")) & _
" ON ACCESS.tbl_Name.FieldName_access = " & rst!FieldName_sqlsvr & _
" SET ACCESS.tbl_Name.FieldName_access = " & rst!FieldName_sqlsvr)
These is the whole code.
Option Compare Database
Sub LocalSQLServerConn_Test()
Dim dbOjb As DAO.Database
Dim strDBName As String
Dim strUserName As String
Dim strPassword As String
Set dbObj = CurrentDb()
Set conn = New adodb.Connection
Set rst = New adodb.Recordset
strDBName = "DataSet"
strConnectString = "Provider = SQLOLEDB.1; Integrated Security = SSPI; " & _
"Initial Catalog = " & strDBName & "; Persist Security Info = True; " & _
"Workstation ID = ABCDE12345;"
conn.ConnectionString = strConnectString
conn.Open
strSQL = "SELECT DISTINCT SQLSVR.tbl_Name.FieldName_sqlsvr FROM SQLSVR.tbl_Name"
rst.Open Source:=strSQL, ActiveConnection:=conn, _
CursorType:=adOpenDynamic, LockType:=adLockOptimistic
If rst.RecordCount = 0 Then
MsgBox "No records returned"
Else
rst.MoveFirst
Do While Not rst.EOF
dbObj.Execute ("UPDATE ACCESS.tbl_Name RIGHT JOIN " & _
conn.OpenSchema(adSchemaTables, Array(Empty, Empty, Empty, "SQLSVR.tbl_Name")) & _
" ON ACCESS.tbl_Name.FieldName_access = " & rst!FieldName_sqlsvr & _
" SET ACCESS.tbl_Name.FieldName_access = " & rst!FieldName_sqlsvr)
rst.MoveNext
Loop
End If
conn.Close
rst.Close
Set dbObj = Nothing
End Sub
You should add a linked table (or a pass-through query) to get the data from SQL Server, create an Update Query in your MDB, using a JOIN to update all rows at once (your can use the query designer for this part) and then execute that query using CurrentDb.Execute.