I'm trying to create a simple VBS script that will allow a sql query to create an excel file. All of my code below works, except it puts all 3 columns I am selecting into cell A1. How can I get it to create a standard Excel output with the headers?
set objExcel = CreateObject("Excel.Application")
objExcel.Application.DisplayAlerts = False
set objWorkbook=objExcel.workbooks.add()
Dim Connection
Dim Recordset
Dim SQL
SQL = "SELECT PersonID, FirstName, LastName FROM [TestDB].[dbo].[Persons]"
Set Connection = CreateObject("ADODB.Connection")
Set Recordset = CreateObject("ADODB.Recordset")
Connection.Open = "Provider=SQLOLEDB; Data Source=compname\SQL; Initial Catalog=DB; UID=usera; Integrated Security=SSPI"
Recordset.Open SQL, Connection
dim resultString, oRS
Set oRS = Connection.Execute(SQL)
resultString = oRS.GetString
Recordset.Close
Set Recordset=nothing
Connection.Close
Set Connection=nothing
Set objWorksheet = objExcel.Worksheets("Sheet1")
objWorksheet.Name = "Third"
objWorksheet.Activate
objWorksheet.Cells(1, 1).Value = resultString
objWorkbook.Saveas "C:\Users\usera\Desktop\Testing.xlsx"
objWorkbook.Close
objExcel.workbooks.close
objExcel.quit
set objExcel = nothing
msgbox("Saved")
You're putting all of your data into a single string with resultString = oRS.GetString. Why would you expect that string to parse itself back out into individual values to populate cells?
You need to read from the recordset's Fields collection and populate each cell. Here's a sample that shows how you would do so. (Hint: your code contains lots of repetitive stuff that isn't necessary - pay attention to what mine is doing instead).
Dim Conn
Dim RS
Dim SQL
SQL = "SELECT PersonID, FirstName, LastName FROM [TestDB].[dbo].[Persons]"
Set Conn = CreateObject("ADODB.Connection")
Conn.Open = "Provider=SQLOLEDB; Data Source=compname\SQL; Initial Catalog=DB; UID=usera; Integrated Security=SSPI"
Set RS = Conn.Execute(SQL)
Set Sheet = ActiveSheet
Sheet.Activate
Dim R
R = 1
While RS.EOF = False
Sheet.Cells(R, 1).Value = RS.Fields(0)
Sheet.Cells(R, 2).Value = RS.Fields(1)
Sheet.Cells(R, 3).Value = RS.Fields(2)
RS.MoveNext
R = R + 1
Wend
RS.Close
Conn.Close
Related
I am fairly new to Access and I have been trying for a while to run an Access query and paste the results in Excel using VBA. I have combined some code I found and I think I almost have it but cannot figure out the last step. Here is the code:
Sub test()
Dim ws As Worksheet
Dim A As Object
Dim rs As Object
Application.DisplayAlerts = False
Set A = CreateObject("Access.Application")
Set ws = ThisWorkbook.Sheets("Sheet1")
A.Visible = True
A.OpenCurrentDatabase ("access database path")
A.DoCmd.OpenQuery ("query name")
Set rs = A.CurrentDb().QueryDefs("query name").OpenRecordset()
If Not rs.EOF Then
ws.Range("A1").CopyFromRecordset rs
End If
rs.Close
Application.DisplayAlerts = True
End Sub
I am trying to run the query and paste the results in cell A1 in sheet 1.
I get a "run time error 3219" for the line:
Set rs = A.CurrentDb().QueryDefs("query name").OpenRecordset()
Any help would be greatly appreciated.
Thanks,
G
I adapted your code to fetch data from an Access query without needing to create a full Access.Application instance. Tested and working in Excel 2010.
Const cstrPath As String = "C:\share\Access\Database2.accdb"
Const cstrQuery As String = "qryBase"
Dim dbe As Object 'DAO.DBEngine '
Dim rs As Object 'DAO.Recordset '
Dim ws As Worksheet
Application.DisplayAlerts = True 'leave alerts on during testing '
Set dbe = CreateObject("DAO.DBEngine.120")
Set rs = dbe.OpenDatabase(cstrPath).OpenRecordset(cstrQuery)
If Not rs.EOF Then
Set ws = ThisWorkbook.Sheets("Sheet1")
ws.Range("A1").CopyFromRecordset rs
End If
rs.Close
Application.DisplayAlerts = True
I would use ADODB recordset. Try the below code. Here I'm connecting to an excel workbook, but you can use the same logic for access database, you just need to change the connection string.
Private con As ADODB.Connection
Private ra As ADODB.Recordset
' SqlString = SQL Query
' Sht = Sheet Name, where the output needs to be displayed
' Rng = Range ("C5"), where the output needs to be displayed
Sub DoSql(SqlString As String, Sht As String, Rng As String, Optional IncludeHeading As Boolean = False)
Dim a As String
Dim res As Variant
Set con = New ADODB.Connection
Set ra = New ADODB.Recordset
res = ""
'a = Set the appropriate connection string for your database
'The below connection is referring to the same excel workbook which contains the macro
a = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=""" & ThisWorkbook.FullName & """;Extended Properties=""Excel 12.0 Xml;HDR=YES"";"
'MsgBox a
'MsgBox SqlString
If Not Left("" & con, 8) = "Provider" Then
con.Open a
End If
If Not ra.State = 0 Then
ra.Close
End If
ra.Open SqlString, con
If Not (ra.EOF And ra.BOF) Then
ra.MoveFirst
Sheets(Sht).Select
If IncludeHeading = True Then
For intColIndex = 0 To ra.Fields.Count - 1
Range(Rng).Offset(0, intColIndex).Value = ra.Fields(intColIndex).Name
Next
Range(Rng).Offset(1, 0).CopyFromRecordset ra
Else
Range(Rng).CopyFromRecordset ra
End If
End If
ra.Close
con.Close
End Sub
I have tried a bunch of different ideas, and I'm still stuck. I'm new to VBA, so I can't figure out how to get exactly what I need, because I don't totally understand the language.
I'm looking to add borders (both outer and inner) around each cell in the data that is returned to the query. How can I write this into the code? I'm going to attach a picture of what the user will hopefully see as well.
Here's what I have:
Sub Button1_Click()
Dim con As ADODB.Connection
Dim cmd As ADODB.Command
Dim rs As ADODB.Recordset
Dim WSP1 As Worksheet
Set con = New ADODB.Connection
Set cmd = New ADODB.Command
Set rs = New ADODB.Recordset
Application.DisplayStatusBar = True
Application.StatusBar = "Contacting SQL Server..."
' Remove any values in the cells where we want to put our Stored Procedure's results.
Dim rngRange As Range
Set rngRange = Range(Cells(8, 2), Cells(Rows.Count, 1)).EntireRow
rngRange.ClearContents
' Log into our SQL Server, and run the Stored Procedure
con.Open "Provider=XXXXXXetc"
' Set up the parameter for our Stored Procedure
' (Parameter types can be adVarChar,adDate,adInteger)
cmd.Parameters.Append cmd.CreateParameter("Assembly", adVarChar, adParamInput, 10, Range("B1").Text)
Application.StatusBar = "Running stored procedure..."
cmd.CommandText = "Custom.PRO_BOM_XXXX"
Set rs = cmd.Execute(, , adCmdStoredProc)
' Copy the results to cell B7 on the first Worksheet
Set WSP1 = Worksheets(1)
WSP1.Activate
If rs.EOF = False Then WSP1.Cells(8, 2).CopyFromRecordset rs
rs.Close
Set rs = Nothing
Set cmd = Nothing
con.Close
Set con = Nothing
Application.StatusBar = "Data successfully updated."
End Sub
Current Outcome:
Expected Outcome:
You want something like:
Sub Button1_Click()
Dim con As ADODB.Connection
Dim cmd As ADODB.Command
Dim rs As ADODB.Recordset
Dim WSP1 As Worksheet
Set con = New ADODB.Connection
Set cmd = New ADODB.Command
Set rs = New ADODB.Recordset
Application.DisplayStatusBar = True
Application.StatusBar = "Contacting SQL Server..."
' Remove any values in the cells where we want to put our Stored Procedure's results.
Dim rngRange As Range
Set rngRange = Range(Cells(8, 2), Cells(Rows.Count, 1)).EntireRow
rngRange.ClearContents
' Log into our SQL Server, and run the Stored Procedure
con.Open "Provider=XXXXXXetc"
' Set up the parameter for our Stored Procedure
' (Parameter types can be adVarChar,adDate,adInteger)
cmd.Parameters.Append cmd.CreateParameter("Assembly", adVarChar, adParamInput, 10, Range("B1").Text)
Application.StatusBar = "Running stored procedure..."
cmd.CommandText = "Custom.PRO_BOM_XXXX"
Set rs = cmd.Execute(, , adCmdStoredProc)
' Copy the results to cell B7 on the first Worksheet
Set WSP1 = Worksheets(1)
'
If rs.EOF then
Application.StatusBar = ""
GoTo Closedown
End If
Dim NumRows As Integer, EndRow As Integer, EndCol As Integer
EndCol = 12 ' You can adjust this
NumRows = rs.RecordCount
EndRow = 7 + NumRows ' - Adjust the number 7 if you ever decide to start pasting from 8
' Do the paste
WSP1.Cells(8, 2).CopyFromRecordset rs
' Now set the range:
Dim PastedRange As Range
With WSP1
Set PastedRange = .Range(.Cells(8, 2), .Cells(EndRow, EndCol))
End With
'
PastedRange.Borders.Color = vbBlack ' Thanks for the tip, sktneer
'
Application.StatusBar = "Data successfully updated."
Closedown:
rs.Close: Set rs = Nothing
Set cmd = Nothing
con.Close: Set con = Nothing
End Sub
Thanks to everyone for the help. Here's what I contrived for a working solution:
Sub Button1_Click()
Dim con As ADODB.Connection
Dim cmd As ADODB.Command
Dim rs As ADODB.Recordset
Dim WSP1 As Worksheet
Set con = New ADODB.Connection
Set cmd = New ADODB.Command
Set rs = New ADODB.Recordset
Application.DisplayStatusBar = True
Application.StatusBar = "Contacting SQL Server..."
Set WSP1 = Worksheets(1)
WSP1.Activate
' Remove any values in the cells where we want to put our Stored Procedure's results.
Dim rngRange As Range
Set rngRange = Range(Cells(8, 2), Cells(Rows.Count, 1)).EntireRow
rngRange.ClearContents
rngRange.ClearFormats
' Log into our SQL Server, and run the Stored Procedure
con.Open "Provider=SQLOLEDB;Data Source=XXXXX;Initial Catalog=XXXXX;Integrated Security=SSPI;Trusted_Connection=Yes"
cmd.ActiveConnection = con
Application.StatusBar = "Running stored procedure..."
cmd.CommandText = "PRO_BOM_XXXXX"
Set rs = con.Execute("Exec Custom.PRO_XXXXX '" & ActiveSheet.Range("B1").Value2 & "','" & ActiveSheet.Range("B2").Value2 & "'")
' Copy the results to cell B7 on the first Worksheet
Set WSP1 = Worksheets(1)
If rs.EOF Then
Application.StatusBar = ""
GoTo Closedown
End If
Dim EndCol As Integer
EndCol = 14
WSP1.Cells(8, 2).CopyFromRecordset rs
'find the last row
Dim LastRow As Long
With ActiveSheet
LastRow = .Cells(.Rows.Count, 3).End(xlUp).Row
End With
' Now set the range:
Dim PastedRange As Range
With WSP1
Set PastedRange = .Range(.Cells(8, 2), .Cells(LastRow, EndCol))
End With
'Add borders
PastedRange.Borders.Color = vbBlack
Application.StatusBar = "Data successfully updated."
Closedown:
rs.Close: Set rs = Nothing
Set cmd = Nothing
con.Close: Set con = Nothing
End Sub
Hopefully the question I'm asking is clear and to be honest I'm also new to using Microsoft VBA (literally started trying to use it today). I'm trying to "grab" a query/data table from a Microsoft Access Database and I'm having difficulty understanding the syntax and exactly what commands do. At the moment it appears I'm getting into the query, but only returning the very first cell of the data table with the code:
Private Sub Select_From_Access()
Dim cn As Object
Dim rs As Object
Dim strSql As String
Dim strConnection As String
Dim placementRange As Range
'DescriptionErrorByLot is the worksheet I want to put the table in, the range A1:Z44 is what would hypothetically be cleared
'if it needed to be once there is data there and needs to be updated
Worksheets("DescriptionErrorByLot").Range("A1:Z44").ClearContents
Set cn = CreateObject("ADODB.Connection")
'This is where I want the query (table) to be placed?
Set placementRange = Worksheets("DescriptionErrorByLot").Range("A1")
'Connection string containing provider and file path to the database
strConnection = "Provider=Microsoft.ACE.OLEDB.12.0;" & _
"Data Source=C:\Users\sjevne\Desktop\Database.accdb"
'Selecting the whole table from the query "jc_C2ComplaintCountbyLot10"? This is the queries name in the database
'To better explain what I'm talking about, there's buttons I can click on in the access database inside of the
'Reports section (click 'Reports' button) and then I click another button "Description errors by lot" and then
'A table/query with the name jc_C2ComplaintCountbyLot10 is open
strSql = "SELECT * FROM jc_C2ComplaintCountByLot10;"
cn.Open strConnection
Set rs = cn.Execute(strSql)
placementRange.CopyFromRecordset rs
rs.Close
Set rs = Nothing
cn.Close
Set cn = Nothing
End Sub
Basically all I'm wondering right now is, what's actually allowing me to return the first cell in the data table I'm interested in? and how can I extend the range to grab the whole thing, obviously?
Any help would be much appreciated! Thanks in advance.
EDIT 1 : Code
EDIT 2 : I've been playing around with the code again, when I tried changing the SELECT * FROM to an existing connection that I was previously using to the database query that I want, and it said something about multi-valued cells and not being able to get data from a different database. (This connection to the worksheet was previously used to make an automated table, so as database table values changed, the spreadsheet did. All I'm trying to do now is just 'copy and paste' using a macro since the previous method is no longer available, sadly.
Here is something similar grabbing the whole table, I do not bring in the field names they are already there. Don't forget when you do this the IDs are coming with the table field data.
Private Sub getDataTable_Click()
Dim conn As Object ' connection
Dim rs As Object 'record set
Dim strSql As String
Dim strConnection As String
Dim placementRange As Range
'UPDATE THIS FOR YOUR WORKSHEET AND RANGE IF YOU WANT TO CLEAR BEFORE COPY
Worksheets("mtrInteraction").Range("I2:P25").ClearContents
Set conn = CreateObject("ADODB.Connection")
'update this for the workbook,worksheet, and range where you want it
'UPDATE THIS FOR THE SHEET AND THE RANGE WHERE YOU WANT THE TABLE, UPPER LEFT CORNER
Set placementRange = Worksheets("mtrInteraction").Range("I2")
'UPDATE THIS FOR YOUR PATH AND DB NAME
'Build your connection and path
strConnection = "Provider=Microsoft.ACE.OLEDB.12.0;" & _
"Data Source=C:\yourpath\yourpath\updatethis.accdb"
'UPDATE THIS FOR YOUR QUERY, TABLE NAME IS ALL YOU HAVE TO CHANGE TO COPY THE WHOLE TABLE, THE DB NAME IS SPECIFIED IN THE CONNECTION ABOVE
'Make your sql query to select all from YOUR table name
strSql = "SELECT * FROM tbl_MTR;"
'open it you might want an error handler here
conn.Open strConnection
'get the recordset
Set rs = conn.Execute(strSql)
'copy your recordset in
placementRange.CopyFromRecordset rs
rs.Close
Set rs = Nothing
conn.Close
Set conn = Nothing
End Sub
Here is the same thing in a stub that has the field name you want and a data value in a cell for specific targeting:
Private Sub CommandButton1_Click()
Dim inputSheet As Worksheet
Dim fieldSTR As String
Dim placementRange As Range
Dim rs As Object 'record set
Dim conn As Object
Dim strQuery As String
Dim myDB As String
Set inputSheet = ThisWorkbook.Worksheets("Sheet1")
Set placementRange = inputSheet.Range("E2")
fieldSTR = CStr(inputSheet.Cells(3, 3).Value) 'C3 cell
myDB = "C:\yourpath\yourpath\updatethis.accdb"
Set conn = CreateObject("ADODB.Connection")
With conn
.Provider = "Microsoft.ACE.OLEDB.12.0" 'For *.ACCDB Databases
.ConnectionString = myDB
.Open
End With
strQuery = "SELECT * FROM " & _
"tbl_test WHERE Color = " & "'" & fieldSTR & "'" & ";"
'The below gives the same result as * but you could limit the fields returned as well
'tbl_test.ID, tbl_test.Color, tbl_test.number
MsgBox (strQuery)
Set rs = conn.Execute(strQuery)
placementRange.CopyFromRecordset rs
rs.Close
Set rs = Nothing
conn.Close
Set conn = Nothing
End Sub
This code works for me, it's stripped bare so it may not compile cleanly:
Sub LoadRecordset(Sheet1 As Worksheet, query As String)
Dim cnpubs As ADODB.Connection
Dim rsPubs As ADODB.Recordset
Set cnpubs = New ADODB.Connection
cnpubs.ConnectionString = "Driver={SQL Server};Server=TESTDS;Database=TEST1;UID=sa;PWD=WERQEWDS"
cnpubs.Open
Set rsPubs = New ADODB.Recordset
With rsPubs
.ActiveConnection = cnpubs
.Open query
fldCount = .Fields.Count
iRow = 1
Sheet1.Rows(iRow & ":" & Rows.Count).Delete
For iCol = 0 To fldCount - 1
Sheet1.Cells(iRow, iCol + 1).Value = .Fields(iCol).Name
Next
iRow = iRow + 1
Sheet1.Range("A" & iRow).CopyFromRecordset rsPubs
.Close
End With
cnpubs.Close
Set rsPubs = Nothing
Set cnpubs = Nothing
Sheet1.Cells.EntireColumn.AutoFit
End Sub
I construct hundreds of SQL Queries in an excel sheet and each one is placed in a cell of 1 column. What I am looking to do is run each of these SQL statements from excel.
Just wondering if anyone knows a way to convert all my SQL into VBA Strings to that I can loop through all rows to run each query.
I found this which is what I want to do but is there a way I can alter the code so it can read off excel cells rather than a Form?
http://allenbrowne.com/ser-71.html
Thanks
EDIT: Here is a sample SQL that I am trying to convert
SELECT
TT.TEST_TABLE_ID,
TT.TEST_TABLE_NO,
TT.MEMBERSHIP_NUMBER,
TT.TEST_TABLE_TYPE,
from TEST_TABLE TT
I think because each Select is in its own line it causes problems when it converts.
EDIT #2: Here is my code that executes SQL
Sub GetData()
Dim Conn As New ADODB.Connection
Dim RS As New ADODB.Recordset
Dim cmd As New ADODB.Command
Dim sqlText As String
Dim Row As Long
Dim Findex As Long
Dim Data As Worksheet
Dim X As Long
Set Data = Sheets("Results")
Data.Select
Cells.ClearContents
Conn.Open "PROVIDER=ORAOLEDB.ORACLE;DATA SOURCE=ORCL;USER ID=user;PASSWORD=password"
cmd.ActiveConnection = Conn
cmd.CommandType = adCmdText
'sqlText = How to reference Valid SQL cells
cmd.CommandText = sqlText
Set RS = cmd.Execute
For X = 1 To RS.Fields.Count
Data.Cells(1, X) = RS.Fields(X - 1).Name
Next
If RS.RecordCount < Rows.Count Then
Data.Range("A2").CopyFromRecordset RS
Else
Do While Not RS.EOF
Row = Row + 1
For Findex = 0 To RS.Fields.Count - 1
If Row >= Rows.Count - 50 Then
Exit For
End If
Data.Cells(Row + 1, Findex + 1) = RS.Fields(Findex).Value
Next Findex
RS.MoveNext
Loop
End If
Cells.EntireColumn.AutoFit
End Sub
in the SQL text part I want to be able to reference my column of SQL statements that I have. I thought I needed to convert it but you guys are right that if referencing it I can Just use your code Brad.
I tried to incorporate your code brad where my 'sqlText = How to reference Valid SQL cells is but had no success
Here is a start to the code I think you need.
I have placed the SQL in a sheet named "SQL", in Col A.
The issues with this are:
(1) You are placing field names in a row, then the data that is returned into a row. That will require two rows per SQL statement.
(2) I copied the SQL statement from sheet "SQL' and placed in Col A of "Results" (you mentioned you wanted to place results to right of SQL String. (3) You clear the contents of "Results" sheet, so you need to be careful not to erase your SQL if you decide to combine sheets.
Option Explicit
Sub Process_SQL_Strings()
Dim cmd As New ADODB.Command
Dim sqlText As String
Dim Row As Long
Dim Findex As Long
Dim Data As Worksheet
Dim iFldCt As Long
Dim conn As ADODB.Connection
Dim rs As ADODB.Recordset
Dim sConn As String
Dim lLastRow As Long
Dim lRow As Long
Set Data = Sheets("Results")
Data.Select
Cells.ClearContents
conn.Open "PROVIDER=ORAOLEDB.ORACLE;DATA SOURCE=ORCL;USER ID=user;PASSWORD=password"
cmd.ActiveConnection = conn
cmd.CommandType = adCmdText
'' Set conn = New ADODB.Connection
'' sConn = "Provider=Microsoft.ACE.OLEDB.12.0;" & _
'' "Data Source=C:\data\access\tek_tips.accdb;" & _
'' "Jet OLEDB:Engine Type=5;" & _
'' "Persist Security Info=False;"
conn.Open sConn
'sqlText = How to reference Valid SQL cells
lRow = 1
Do
sqlText = Sheets("SQL").Range("A" & lRow)
If sqlText = "" Then
MsgBox "Finished processing " & lRow & " rows of SQL", vbOKOnly, "Finished"
GoTo Wrap_Up
End If
Set rs = New ADODB.Recordset
rs.Open sqlText, conn, adOpenStatic, adLockBatchOptimistic, adCmdText
Data.Cells(lRow, 1) = sqlText
If not rs.EOF then
For iFldCt = 1 To rs.Fields.Count
Data.Cells(lRow, 1 + iFldCt) = rs.Fields(iFldCt - 1).Name
Next
If rs.RecordCount < Rows.Count Then
Data.Range("B" & lRow).CopyFromRecordset rs
Else
Do While Not rs.EOF
Row = Row + 1
For Findex = 0 To rs.Fields.Count - 1
If Row >= Rows.Count - 50 Then
Exit For
End If
Data.Cells(Row + 1, Findex + 1) = rs.Fields(Findex).value
Next Findex
rs.MoveNext
Loop
End If
Cells.EntireColumn.AutoFit
End If
lRow = lRow + 1
Loop
Wrap_Up:
rs.Close
Set rs = Nothing
conn.Close
Set conn = Nothing
End Sub
I am using something this:
Function SQLQueryRun(ByVal query As String, ByVal returnData As Boolean) As Variant
Dim Conn As New ADODB.Connection
Dim ADODBCmd As New ADODB.Command
Dim ret As New ADODB.Recordset
Conn.ConnectionString = "connection_string_here"
Conn.Open
ADODBCmd.ActiveConnection = Conn
ADODBCmd.CommandText = query
Set ret = ADODBCmd.Execute()
If returnData Then
If Not ret.EOF Then SQLQueryRun = ret.GetRows()
Else
SQLQueryRun = True
End If
Conn.Close
Set Conn = Nothing
Set ret = Nothing
End Function
If the second argument is False nothing is returned by function. Are you expecting results from query run?
Also I use a macro to create Query/Pivot table from sql contained in windows clipboard, if you are interested let me know.
You'll need to create a connection to your database and loop through all the cells and execute your code in each cell.
You can use ADO to to make the connection (need to add a reference to Microsoft ActiveX Data Objects 6.1 Library)
You'll need to figure out your connection string, open a connection, then loop through all the cells and execute the SQL in those cells.
Dim cnn As New ADODB.Connection
Dim connectionString As String
Dim cmd As New ADODB.Command
Dim c As Range, ws As Worksheet
Dim rst as ADODB.Recordset
connectionString = "Provider=Microsoft.ACE.OLEDB.12.0;Data source=C:\Database3.accdb;Persist Security Info=False;"
cnn.Open connectionString
cmd.ActiveConnection = cnn
For Each c In ws.Range()
cmd.CommandText = c.Value
set rst = cmd.Execute
'do what you need to with your new recordset before moving on to the next SELECT
Next c
my code below, whoch I've copied from a Yahoo Developers articles and changed accordingly, for Query, I want to copy and paste 2999 rows of insert statements from excel to Teradata. My current way doesn't copy and paste the entire range. If I swap this for: Cells(1, 1) & " " & Cells(2, 1) & " " & Cells(3, 1)....etc. until Cells(2999), it would work. A clever, simpler way of doing this please?
As an aside, would you recommend an alternative method of inserting 2999 rows.
The tables are already populated, so FLOAD won't work. MLOAD or BTEQ? I'm using normal insert statements because 2999 is small enough to get away with. But, I'd always be very grateful for a q quicker solution! Thank you all!
Sub Insert_to_TD()
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
cn.Open "DSN=NNNNNN; Username=XXXXX; Password=YYYYYYY;"
Set cmdsqldata.ActiveConnection = cn 'This line says to which database it has to send the query
Query = Range(Cells(1, 1), Cells(2999, 1))
cmdsqldata.CommandText = Query 'We asign the query as command text
cmdsqldata.CommandType = adCmdText 'We just say what kind of command VBA has to execute
cmdsqldata.CommandTimeout = 0 'With this instruction we don't set any timeout, so the query can take all the necessary time to be executed
Set rs = cmdsqldata.Execute() 'VBA just run the query and send back the result
End Sub
This will cause no error, using VBA Join():
Function GetColumn1(varArray)
Dim i, i0, i1, varArrayRet
i0 = LBound(varArray, 1)
i1 = UBound(varArray, 1)
ReDim varArrayRet(i0 To i1)
For i = i0 To i1
varArrayRet(i) = varArray(i, 1)
Next
GetColumn1 = varArrayRet
End Function
Sub Insert_to_TD()
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 varArray, Query
cn.Open "DSN=NNNNNN; Username=XXXXX; Password=YYYYYYY;"
Set cmdsqldata.ActiveConnection = cn 'This line says to which database it has to send the query
'
'Query = Range(Cells(1, 1), Cells(2999, 1))
'
varArray = Range("A1:A2999").Value
varArray = GetColumn1(varArray)
Query = Join(varArray, " ")
cmdsqldata.CommandText = Query 'We asign the query as command text
cmdsqldata.CommandType = adCmdText 'We just say what kind of command VBA has to execute
cmdsqldata.CommandTimeout = 0 'With this instruction we don't set any timeout, so the query can take all the necessary time to be executed
Set rs = cmdsqldata.Execute() 'VBA just run the query and send back the result
End Sub
Reserve:
Although you'd better use a for loop, insert your data line/line, it will be faster and better done than a bundled insert's.
Now we try run SQL line by line?
Sub Insert_to_TD()
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 i, strSQL
cn.Open "DSN=NNNNNN; Username=XXXXX; Password=YYYYYYY;"
Set cmdsqldata.ActiveConnection = cn
cmdsqldata.CommandType = adCmdText
cmdsqldata.CommandTimeout = 0
'
For i = 1 To 2999
strSQL = ActiveSheet.Cells(i, 1).Value
cmdsqldata.CommandText = strSQL
Set rs = cmdsqldata.Execute()
Next
End Sub