I am trying to avoid a timeout situation happening. At present the script runs 100% on the test environment, but everything is running local. Therefore now installed on the live environment, it does take a little longer. However it would appear VB timeout default is set to 30 secs. However not being 100% familiar with VB unlike with SQL, then I am unsure on the code to set it. Current code is as follows:
Dim strFile As String
Dim strCon As String
Dim strSQL As String
Dim dateRows As Variant
Dim i As Integer
Dim today As Date
Dim cn As ADODB.Connection
Dim rs As ADODB.Recordset
strFile = Workbooks(1).FullName
strCon = "Provider=SQLOLEDB.1; Data Source=ABC;Initial catalog=ABC;Integrated Security=ABC;"
Set cn = CreateObject("ADODB.Connection")
Set rs = CreateObject("ADODB.Recordset")
range1 = Sheets("Line data ( Do not alter )").Range("AA9")
cn.Open strCon
strSQL = "Select "order by userid, appointmentdate "
rs.Open strSQL, cn
Sheets("Line data ( Do not alter )").Range("AA9").CopyFromRecordset rs
cn.Close
Set rs = Nothing
Set cn = Nothing
End Sub
I found code which states comm.CommandTimeout=10, but unsure where to put it..
Any help appreciated.
In ADODB you have 2 timeouts:
The Connection timeout as documented here
The Command timeout as documented here
Connection timeout triggers when trying to open the connection.
Command timeout when you're running the command.
If you're receiving an error on the cn.Open line:
You should set cn.ConnectionTimeout = someSeconds
If you're receiving it on the rs.Open line:
You should set cn.CommandTimeout = someSeconds
Related
I'm not sure what is wrong with my code here, it is not throwing any errors and is compiling successfully. However, the recordset is not grabbing any data. Nothing is being pasted into the sheet. The query itself runs fine from command line/sqlserver. Do I need to add a dsn somewhere in the connection string?
Sub queryTest()
Dim connection As New ADODB.connection
Dim recordset As ADODB.recordset
Dim strSQL As New ADODB.Command
connection.Open "DRIVER={SQL Server};SERVER=xxx;" & _
"trusted_connection=yes;DATABASE=xxxx"
strSQL.ActiveConnection = connection
strSQL.CommandText = "SELECT TOP (50) [CalendarSK] ,[CalendarMonthSK] ,[CalendarDate] FROM [xxxx].[dbo].[tblCalendar]"
strSQL.CommandType = adCmdText
Set recordset = strSQL.Execute
Sheets("Sheet1").Range("a1").CopyFromRecordset recordset
recordset.Close
connection.Close
End Sub
I have the below Macro reading from a Database table stored as a txt file on the local C drive and returning an SQL query.
Public Function getData(fileName As String) As ADODB.Recordset
Dim cN As ADODB.Connection
Dim RS As ADODB.Recordset
Set cN = New ADODB.Connection
Set RS = New ADODB.Recordset
cN.Open ("Provider=Microsoft.Jet.OLEDB.4.0;Data Source=C:\Cloud\;Persist
Security Info=False;Extended Properties=""text; HDR=Yes; FMT=Delimited;
IMEX=1;""")
RS.ActiveConnection = cN
RS.Source = "select top 10 * from " & fileName
Set getData = RS
End Function
I can then call the function and return data using the below, so far so good...
Sub Cloud()
Dim a As ADODB.Recordset
Set a = getData("file.txt")
a.Open
MsgBox (a.GetString())
a.Close
End Sub
BUT now I would like to move 'file.txt' from C:\Cloud\ to a HTTP location, ie http://it.wont.work/
How would I amend the above for this to work? I've searched and tested but nothing seems to work... I either get internet login failed or ISAM not found.
Many thanks
When running the below code I keep getting an Automation error, for the life of me I can't figure out why. Can anyone shed some light?
When I use the debug it highlights the below;
rs.Open SQLStr, cn
I saw some references to
I've been tasked to get data from a SQL DB based off the values in Column A Row 3 onwards.
Example of Excel Sheet:
ITEM | QTY TO PICK | QTY ON ORDER | Column 2 | Column 3 etc
PART 1 | 5 | <Data will be populated here>
PART 2 | 12 | <Data will be populated here>
This code runs through a Command Button.
The data pulled from SQL will be populated starting in C3 onwards.
Private Sub CommandButton2_Click()
' Create a connection object.
Dim cn As ADODB.Connection
Set cn = New ADODB.Connection
' Provide the connection string.
Dim strConn As String
'Use the SQL Server OLE DB Provider.
strConn = "Provider=SQLOLEDB;"
'Connect to the Pubs database on the local server.
strConn = strConn & "server=<server name>;INITIAL CATALOG=<DB Name>;"
'Use an integrated login.
strConn = strConn & " INTEGRATED SECURITY=sspi;"
'Now open the connection.
cn.Open strConn
'
'
ActiveSheet.Range("C3:G10000").Clear ' clear out existing data
Dim ItemNumber As String
ItemNumber = Range("A3").Value
' Create a recordset object.
Dim rs As ADODB.Recordset
Set rs = New ADODB.Recordset
SQLStr = "Select * from vw_WorksOrder WHERE ITEMNO = " & ItemNumber & ""
rs.Open SQLStr, cn
' Copy the records into cell A1 on Sheet1.
Sheet4.Range("C3").CopyFromRecordset rs
' Tidy up
rs.Close
cn.Close
Set rs = Nothing
Set cn = Nothing
As #Zac points out with incorrect use of quotes which resolves issue, consider not using quotes or variable concatenation at all by employing the industry best practice of parameterization. ADO can parameterize SQL calls using its Command CreateParameter method.
See below example using your setup where a ? is used as placeholder in prepared statement, then a parameter is later appended defining its name, type, direction size, and value.
...
Dim cmd As New ADODB.Command
With cmd
.ActiveConnection = cn
.CommandText = "SELECT * FROM vw_WorksOrder WHERE ITEMNO = ?"
.CommandType = adCmdText
.Parameters.Append cmd.CreateParameter("itemparam", adVarChar, adParamInput, 255, ItemNumber)
End With
Dim rs As New ADODB.Recordset
Set rst = cmd.Execute
...
Also, another industry best practice is error and exception handling for runtime errors as AutomationError is not useful for debugging. And you want to release all Set objects regardless of error or not. In VBA, you can use the On Error handling to output more useful messages and release objects from memory accordingly.
Private Sub CommandButton2_Click()
On Error Goto ErrHandle
'...same code but without any Set obj = Nothing (since used in ExitHandle)
ExitHandle:
Set rs = Nothing
Set cmd = Nothing
Set cn = Nothing
Exit Sub
ErrHandle:
Msgbox Err.Number & " - " & Err.Description
Resume ExitHandle
End Sub
This is my first question so constructive criticism is welcome! I am attempting to query an access database from excel vba and place the return information into an Excel range. I get this error:
Error Message: "Run-time error '3709' The connection cannot be used to
perform this operation. It is either closed or invalid in this
context."
Code:
Sub Importfromaccess()
Path = "C:\Users\myUser\Desktop\Database1.accdb"
Set cn = CreateObject("ADODB.connection")
cn.Open "Provider=Microsoft.ACE.OLEDB.12.0; Data Source=" & Path & ";"
Set rs1 = CreateObject("ADODB.recordset")
rs1.activeconnection = cn
Dim strSQL As New ADODB.Command
strSQL.CommandText = "SELECT * FROM Tooling WHERE TID=BD0001"
strSQL.CommandType = adCmdText
Set rs1 = strSQL.Execute ' This is the line the error occurs on
Sheets("Calc").Range("K1").CopyFromRecordset rs1
End Sub
I have enabled the following references:
Visual Basic For Applications,
Microsoft Excel 16.0 Object Library,
OLE Automation,
Microsoft Office 16.0 Object Library,
Microsoft Access 16.0 Object Library,
Microsoft ActiveX Data Objects 2.0 Library,
I tried placing the line:
cn.Open "Provider=Microsoft.ACE.OLEDB.12.0; Data Source=" & Path & ";"
right before the error line and received this error:
Run-time error '3705': Operation is not allowed when the object is
open.
Anybody know what my problem might be?
First (and unrelated to your error), unless you need to support clients using Windows 2000 or earlier, you should reference the highest Microsoft ActiveX Data Objects version instead of 2.0. If you're only using ADODB to interact with the database, you don't need the Microsoft Access 16.0 Object Library at all.
Second, if you already have a reference, don't create late bound objects like this:
Set cn = CreateObject("ADODB.connection")
Adding the reference early binds the type, so explicitly declare them and instantiate them using New:
Dim cn As ADODB.Connection
Set cn = New ADODB.Connection
Your connection string should be fine - where you run into problems are these 2 lines:
Set rs1 = CreateObject("ADODB.recordset")
rs1.activeconnection = cn
Executing an ADODB.Command will return the Recordset, not the other way around. Remove those 2 lines entirely. Instead of attaching the connection to the Recordset, you need to use it when you're building your ADODB.Command:
Dim strSQL As New ADODB.Command
strSQL.ActiveConnection = cn '<---Insert this.
strSQL.CommandText = "SELECT * FROM Table1"
strSQL.CommandType = adCmdText
Also, get rid of the Hungarian notation there - it's confusing as hell. An ADODB command isn't a String, so why should it be named strFoo?
You also need to clean up after yourself - don't leave your recordset and connection just hanging open when you're done with them. Call .Close when you're finished.
Finally, your SQL statement is most likely incorrect - you probably need to enclose your TID in single quotes('):
"SELECT * FROM Tooling WHERE TID='BD0001'"
It should look closer to this:
Sub Importfromaccess()
Dim Path As String
Path = "C:\Users\myUser\Desktop\Database1.accdb"
Dim cn As ADODB.Connection
Set cn = New ADODB.Connection
cn.Open "Provider=Microsoft.ACE.OLEDB.12.0; Data Source=" & Path & ";"
Dim query As New ADODB.Command
query.ActiveConnection = cn
query.CommandText = "SELECT * FROM Tooling WHERE TID='BD0001'"
query.CommandType = adCmdText
Dim rs1 As ADODB.Recordset
Set rs1 = query.Execute ' This is the line the error occurs on
Sheets("Calc").Range("K1").CopyFromRecordset rs1
'CLEAN UP AFTER YOURSELF:
rs1.Close
cn.Close
End Sub
You already Set rs1
How about trying something more like:
Sub Importfromaccess()
Dim strSQL As String, strPath as String
Dim cn as Object, rs1 as Object
strPath = "C:\Users\myUser\Desktop\Database1.accdb"
Set cn = CreateObject("ADODB.connection")
cn.Open "Provider=Microsoft.ACE.OLEDB.12.0; Data Source=" & Path & ";"
Set rs1 = CreateObject("ADODB.Recordset")
strSQL = "SELECT * FROM Tooling WHERE TID='BD0001'"
rs1.Open strSQL, cn
Sheets("Calc").Range("K1").CopyFromRecordset rs1
End Sub
After some thorough rearranging I think I figured it out. I'm surprised at what changes fixed the problem but the following code works:
Dim con As New ADODB.Connection
Dim rs As ADODB.Recordset
Dim cmd As New ADODB.Command
cmd.CommandText = "SELECT * FROM Tooling WHERE TID='BD0001'"
con.Open "Provider=Microsoft.ACE.OLEDB.12.0; Data Source=C:\Users\myUser\Desktop\Database1.accdb;"
cmd.ActiveConnection = con
Set rs = cmd.Execute
Sheets("Calc").Range("K1").CopyFromRecordset rs
rs.Close
con.Close
The final error was fixed with:
cmd.CommandText = "SELECT * FROM Tooling WHERE TID='BD0001'"
this line previously did not include single quotes around BD0001.
I also added an ActiveConnection to the Command object.
Edit: This is the simplest working version of this I could manage courtesy of all you helpful people!
How to change the code below to prevent what you see in the screenshot.
I am running a macro with the following code
Dim conn As ADODB.Connection
Dim rec1 As ADODB.Recordset
Dim thisSql As String
Set conn = New ADODB.Connection
Dim sConn As String
sConn = "Provider=SQLOLEDB;Trusted_Connection=Yes;Server=xyz;Database=xyz;UID=xyz;PWD=xyz"
conn.Open sConn
' this is creating multiple connections.
Set rec1 = New ADODB.Recordset
rec1.Open thisSql, conn
which runs a SQL Server query (which is around 20 lines long and contains 4 joins). Everything is fine except for the fact that after a couple times of running it my DB admin says that my query is loading up the DB too much.
Now, my query could be causing the problem, or it could be that Excel is starting to run multiple connections at once. Some evidence for this is the screenshot below and the fact that the load on the database appears to increase with time.
How do I establish a DB connection without constantly creating new connections?
Has anyone had similar problems working with Excel DB macros?
UPDATE
While the answers below were very useful (especially for someone starting out in VBA), it seems that the main reason my query was taking up load was a combination of multiple connections and having overlooked a line in my code:
With Sheets("FVols").QueryTables.Add(Connection:=rec1, Destination:=Sheets("FVols").Range("A1"))
.name = "data"
.FieldNames = True
.Refresh BackgroundQuery:=True <<<<<<<<<<<<<<<<<<<<<<<-----
End With
You only need to open the connection once. That literally means you can execute multiple queries on that one active connection. You must close the connection and free the reference (specially with ADODB) to avoid running into collisions and other connection related problems.
If you know the queries you are going to be executing you can create an array (or collection) and add queries to the queue.
While you already have an open connection to work with you can keep executing queries.
Scan through code there is not much difference between yours and mine so you should be able to see what is going on and where. Please, ask questions in the comments if anything is unclear
Sub DbConnection()
Dim cn As ADODB.Connection
Set cn = New ADODB.Connection
Dim rs As ADODB.Recordset
Dim strConn As String
strConn = "Driver={SQL Server};Server=; Database=; UID=; PWD="
cn.Open strConn
Dim queryArr, i
queryArr = Array("SELECT * FROM [MyTable]", "SELECT * FROM [MyOtherTable]")
For i = LBound(queryArr) To UBound(queryArr)
ExecuteQuery queryArr(i), cn, rs
Next i
cn.Close
Set cn = Nothing
End Sub
Private Sub ExecuteQuery(query As Variant, ByRef cn As ADODB.Connection, ByRef rs As ADODB.Recordset)
Set rs = New ADODB.Recordset
With rs
.ActiveConnection = cn
.Open CStr(query)
Sheets(1).Range("A1").CopyFromRecordset rs
.Close
End With
Set rs = Nothing
End Sub
Now, you only need to execute the DBConnection() once and all the queries you listed in the array will be executed.
Alternatively, if your queries are created at run-time you can pass it to the DbConnection() as a parameter.
Sub DbConnection(queryQueue As Collection)
Dim cn As ADODB.Connection
Set cn = New ADODB.Connection
Dim rs As ADODB.Recordset
Dim strConn As String
strConn = "Driver={SQL Server};Server=HELIUM\PRI; Database=sourcedata; UID=tabula; PWD=Tabula123!"
cn.Open strConn
For i = 1 To queryQueue.Count
ExecuteQuery queryQueue.Item(i), cn, rs
Next i
cn.Close
Set cn = Nothing
End Sub
Private Sub ExecuteQuery(query As Variant, ByRef cn As ADODB.Connection, ByRef rs As ADODB.Recordset)
Set rs = New ADODB.Recordset
With rs
.ActiveConnection = cn
.Open CStr(query)
Sheets(1).Range("A1").CopyFromRecordset rs
.Close
End With
Set rs = Nothing
End Sub
Update:
You can declare your connection as a Global Variable. Now you can run the DBConnection() as many times as you like and you will not be creating a new connection each time. Instead you will be using the global connection object.
Option Explicit
Public cn As ADODB.Connection
Sub DbConnection()
Set cn = New ADODB.Connection
Dim rs As ADODB.Recordset
Dim strConn As String
strConn = "Driver={SQL Server};Server=; Database=; UID=; PWD="
cn.Open strConn
Set rs = New ADODB.Recordset
With rs
.ActiveConnection = cn
.Open "SELECT * FROM [MyTable]"
Sheets(1).Range("A1").CopyFromRecordset rs
.Close
End With
Set rs = Nothing
cn.Close
Set cn = Nothing
End Sub
Are you releasing the connection variable when you've finished with it? i.e.
Set rec1 = Nothing
The connection won't close fully if not.