Need help creating temporary table using ADO from VBA - sql

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.

Related

Any Other Way To Speed Up Code For INSERT INTO STATEMENTS for N Rows?

Im making Codes Inserting Data into a autonumber Columns to a table that composes of Two COlumns.
My Table is Access and Front End is Excel. My Access Table contains ID (which is AutoNumber) and Paycode which is base on a cell. I need this codes to use it as Unique IDs in which later on will post it back to Ms Access separate Table.
Sub ImportJEData()
Dim cnn As ADODB.Connection 'dim the ADO collection class
Dim rst As ADODB.Recordset 'dim the ADO recordset class
Dim dbPath
Dim x As Long
Dim var
Dim PayIDnxtRow As Long
'add error handling
On Error GoTo errHandler:
'Variables for file path and last row of data
dbPath = Sheets("Update Version").Range("b1").Value
Set var = Sheets("JE FORM").Range("F14")
PayIDnxtRow = Sheets("MAX").Range("c1").Value
'Initialise the collection class variable
Set cnn = New ADODB.Connection
'Create the ADODB recordset object.
'Set rst = New ADODB.Recordset 'assign memory to the recordset
'Connection class is equipped with a —method— named Open
'—-4 aguments—- ConnectionString, UserID, Password, Options
'ConnectionString formula—-Key1=Value1;Key2=Value2;Key_n=Value_n;
cnn.Open "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & dbPath
'two primary providers used in ADO SQLOLEDB —-Microsoft.JET.OLEDB.4.0 —-Microsoft.ACE.OLEDB.12.0
'OLE stands for Object Linking and Embedding, Database
Do
On Error Resume Next 'reset Err.obj.
'Get the Max ID +1
Set rst = Nothing
Set rst = New ADODB.Recordset 'assign memory to the recordset
SQL = "SELECT Max(ApNumber)+1 FROM PayVoucherID "
rst.Open SQL, cnn
'Check if the recordset is empty.
If rst.EOF And rst.BOF Then
'Close the recordet and the connection.
Sheets("Max").Range("A2") = 1
Else
'Copy Recordset to the Temporary Cell
Sheets("MAX").Range("A2").CopyFromRecordset rst
End If
'Insert the Data to Database And Check If no Errors
Sql2 = "INSERT INTO PayVoucherID(ApNumber)Values('" & Sheets("MAX").Range("A2") & "') "
cnn.Execute Sql2
Loop Until (Err.Number = 0)
'And if No errors COpy temporary to NEw Sub Temporary Data for Reference
Sheets("LEDGERTEMPFORM").Range("D1").Value = Sheets("MAX").Range("A2").Value
'Securing ChckID Seq Number
'ADO library is equipped with a class named Recordset
For x = 1 To PayIDnxtRow
Set rst = Nothing
Set rst = New ADODB.Recordset 'assign memory to the recordset
rst.AddNew
'Insert the Data to Database And Check If no Errors
Sql2 = "INSERT INTO PayPaymentID(ApNumber)Values('" & Sheets("LEDGERTEMPFORM").Range("B2") & "') "
cnn.Execute Sql2
Next x
Set rst = Nothing
Set rst = New ADODB.Recordset 'assign memory to the recordset
SQL = "Select PayID From PayPaymentID where APNumber = " & Sheets("LEDGERTEMPFORM").Range("B2") & " order by PayID "
rst.Open SQL, cnn
Sheets("PaySeries").Range("B2").CopyFromRecordset rst
Set rst = Nothing
rst.Close
' Close the connection
cnn.Close
'clear memory
Set rst = Nothing
Set cnn = Nothing
'communicate with the user
'MsgBox " The data has been successfully sent to the access database"
'Update the sheet
Application.ScreenUpdating = True
On Error GoTo 0
Exit Sub
errHandler:
'clear memory
Set rst = Nothing
Set cnn = Nothing
MsgBox "Error " & Err.Number & " (" & Err.Description & ") in procedure Export_Data"
End Sub
In this section Below Would like to know if theres another way without using or even faster type of loop.
'Securing ChckID Seq Number
'ADO library is equipped with a class named Recordset
For x = 1 To PayIDnxtRow
Set rst = Nothing
Set rst = New ADODB.Recordset 'assign memory to the recordset
rst.AddNew
'Insert the Data to Database And Check If no Errors
Sql2 = "INSERT INTO PayPaymentID(ApNumber)Values('" & Sheets("LEDGERTEMPFORM").Range("B2") & "') "
cnn.Execute Sql2
Next x
Set rst = Nothing
Set rst = New ADODB.Recordset 'assign memory to the recordset
SQL = "Select PayID From PayPaymentID where APNumber = " & Sheets("LEDGERTEMPFORM").Range("B2") & " order by PayID "
rst.Open SQL, cnn
Sheets("PaySeries").Range("B2").CopyFromRecordset rst
Finally Ive figured it Out it went better from 40 to 19s Thanks to the idea of #miki180.
Heres my code below starting from DO...
Do
On Error Resume Next 'reset Err.obj.
'Get the Max ID +1
Set rst = Nothing
Set rst = New ADODB.Recordset 'assign memory to the recordset
SQL = "SELECT Max(ApNumber)+1 FROM PayVoucherID "
rst.Open SQL, cnn
'Check if the recordset is empty.
'Copy Recordset to the Temporary Cell
Sheets("MAX").Range("A2").CopyFromRecordset rst
'Insert the Data to Database And Check If no Errors
Sql2 = "INSERT INTO PayVoucherID(ApNumber)Values('" & Sheets("MAX").Range("A2") & "') "
cnn.Execute Sql2
Loop Until (Err.Number = 0)
xlFilepath = Application.ThisWorkbook.FullName
SSql = "INSERT INTO PaypaymentID(Apnumber) " & _
"SELECT * FROM [Excel 12.0 Macro;HDR=YES;DATABASE=" & xlFilepath & "].[MAX$G1:G15000] where APNumber > 1"
cnn.Execute SSql
Set rst = Nothing
Set rst = New ADODB.Recordset 'assign memory to the recordset
SQL = "Select PayID From PayPaymentID where APNumber = " & _
Sheets("LEDGERTEMPFORM").Range("B8") & " order by PayID "
rst.Open SQL, cnn
Sheets("PaySeries").Range("B2").CopyFromRecordset rst

Determine if record exists when updating Access database using Excel VBA

I am trying to update records, or create records if the unique ID does not exist.
The code gives me an error telling me that it would create duplicate values.
I need to include this in my code "SQL: If Exists Update Else Insert".
Sub Upload_Excel_to_Access()
Dim wbpath As String
wbpath = Application.ActiveWorkbook.Path
Dim con As Object '' ADODB.Connection
Set con = CreateObject("ADODB.Connection") '' New ADODB.Connection
con.Open "Provider=Microsoft.ACE.OLEDB.12.0;Data source=\\at\HRS SD Performance Data\Capacity DB.accdb;"
con.Execute _
"INSERT INTO AssigenedVol_tbl " & _
"SELECT * FROM [Excel 12.0 Xml;HDR=YES;IMEX=2;ACCDB=YES;DATABASE=C:\Users\luga\Desktop\Databasetest\DB Macro Test.xlsm].[rawdata$]"
con.Close
Set con = Nothing
End Sub
The table name is "AssigenedVol_tbl"
Fields are: Process_Identifier, Login, Volume, effDate, ID_Unique (This is the primary key in the database)
Modify the insert statement to check for the existence of the key. Given what you explained, that would be
Sub Upload_Excel_to_Access()
Dim wbpath As String
wbpath = Application.ActiveWorkbook.Path
Dim con As Object '' ADODB.Connection
Set con = CreateObject("ADODB.Connection") '' New ADODB.Connection
con.Open "Provider=Microsoft.ACE.OLEDB.12.0;Data source=\\at\HRS SD Performance Data\Capacity DB.accdb;"
con.Execute _
"INSERT INTO AssigenedVol_tbl " & _
"SELECT SRC.* FROM [Excel 12.0 Xml;HDR=YES;IMEX=2;ACCDB=YES;DATABASE=C:\Users\luga\Desktop\Databasetest\DB Macro Test.xlsm].[rawdata$] " _
& " AS SRC " _
& "WHERE NOT EXISTS (select 1 from AssigenedVol_Tbl CHK WHERE CHK.ID_Unique = SRC.ID_Unique)"
con.Close
Set con = Nothing
End Sub
Note, the &'s - were done just to focus on the fact that your SRC table is being labelled, and you're checking it as CHK.

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

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

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

Recordset in VB6.0

I'm retrieving Data from a Database in a record set using VB6... so while retrieving data using Select in SQL I added a column called Comments along wit it so that in the recordset, all the columns of the table+'Comments' column would be present... I don't want to(and also I cannot) update any contents in the database as i'm only 'fetching' data frm the database now...
Now when i pass the fetched data for validation, I want to fill the 'comments' Column with the respective errors if the particular row in the recordSet is erroneous).... When i do that i get an error saying "I'm not authorized to do that!!(to update the 'Comments' Column"....
Now My Question is "In what way i can solve this problem???".. I tried to replicate this recordset and there by now filling the 'comments'column (in the replicated one) which in turn showed the same error... It seems this could be because the duplicate one(recordSet) just retains the properties of the original one...
Can u any1 help how to solve this???? Any ways to replicate the recordset(without inheriting its properties something)??????
I think you are just asking how to do a disconnected recordset.
For that you just change the cursor location of the recordset.
Dim rstTest as ADODB.RecordSet
Set rstTest = New ADODB.RecordSet
With rstTest
.CursorLocation = adUseClient
.Open "your sql here", your_connection_object, adOpenStatic, adLockBatchOptimistic, adCmdText
' now disconnect it and force the local copy
.ActiveConnection = Nothing
End With
Not exactly what you are looking for, but this is how I do it:
Create a class to encapsulate the recordset ('Customer' class for 'Customer' table)
Add your Comment property to the class and not to recordset
Add a Validate method to your class. Have it write to your Comment property (I use an Errors Collection)
Read the recordset
Parse it into a "new Customer"
Validate
Check the Comment property (or the Errors Collection)
You can use the MSDataShape with its SHAPE..APPEND syntax to append a new Field to an ADO Recordset. Here's a quick example using Jet (a.k.a. MS Access):
Sub ShapeAppendField()
On Error Resume Next
Kill Environ$("temp") & "\DropMe.mdb"
On Error GoTo 0
Dim cat
Set cat = CreateObject("ADOX.Catalog")
With cat
.Create _
"Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=" & _
Environ$("temp") & "\DropMe.mdb"
Dim jeng
Set jeng = CreateObject("JRO.JetEngine")
jeng.RefreshCache .ActiveConnection
Set .ActiveConnection = Nothing
End With
Dim con
Set con = CreateObject("ADODB.Connection")
With con
.ConnectionString = _
"Provider=MSDataShape;" & _
"Data Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=" & _
Environ$("temp") & "\DropMe.mdb"
.CursorLocation = 3
.Open
.Execute _
"CREATE TABLE Test (" & _
"existing_col INTEGER NOT NULL);"
.Execute _
"INSERT INTO Test (existing_col)" & _
" VALUES (1);"
Dim rs
Set rs = CreateObject("ADODB.Recordset")
With rs
.CursorType = 2
.LockType = 4
.Source = _
"SHAPE {" & _
" SELECT existing_col" & _
" FROM Test" & _
"} APPEND NEW adInteger AS new_col"
Set .ActiveConnection = con
.Open
Set .ActiveConnection = Nothing
.Fields("new_col").value = 55
MsgBox .GetString
.Close
End With
End With
End Sub