I am trying to copy data from a closed Excel 2007 workbook (.xlsx) using an ADO connection.
I have the connection string working. But I get an automation error when I try to open the Command in the Recordset (Second to last line).
This may not be clear in the below code so:
"wsSummary" is a worksheet object
"strSourceFile" is a string with the target data I need to copy from (e.g. Template.xlsx)
strSourceFile = wsSummary.Cells(nFirstRow + 4, 7)
strSheetSource = "Sheet1"
strSQL = "SELECT * FROM [" & strSheetSource & "]"
Set dbConnection = New ADODB.Connection
With dbConnection
.Provider = "Microsoft.ACE.OLEDB.12.0;"
.connectionString = "Data Source=" & strPOINTDataPath & strSourceFile & _
";Extended Properties=""Excel 12.0 Xml;HDR=NO;IMEX=1"";"
.ConnectionTimeout = 40
.Open
End With
If dbConnection = "" Then GoTo ErrorText
Set cmd = New ADODB.Command
With cmd
.ActiveConnection = dbConnection
.CommandText = strSQL
End With
Set rs = New ADODB.Recordset
With rs
.ActiveConnection = dbConnection
.CursorLocation = adUseClient
.CursorType = adOpenDynamic
.LockType = adLockOptimistic
.Open cmd
End With
I think you missed $ character in your SQL statement. Try to change appropriate line into this one:
strSQL = "SELECT * FROM [" & strSheetSource & "$]"
or change strSheetSource variable into this:
strSheetSource = "Sheet1$"
Related
I use VBA Word with Access, to create/store medical visit notes for Nursing homes.
The following is an example of how I get data out of Access (obviously picking up mid-Sub). This is populating a ComboBox in Word which gives me a list of all my patients, it is working great!
'....
Set Conn = New ADODB.Connection
Set rs = New ADODB.Recordset
strConn = ActiveDocument.CustomDocumentProperties("strConn").Value
Conn.Open (strConn)
qry = "SELECT * FROM tblPatientInfo ORDER BY LastName, Firstname"
rs.Open qry, Conn, adOpenKeyset
rs.MoveFirst
x = 0
While Not rs.EOF
F1.ComboDashPtList.AddItem
F1.ComboDashPtList.List(x, 0) = rs.Fields("LastName").Value & ""
F1.ComboDashPtList.List(x, 1) = rs.Fields("FirstName").Value & ""
F1.ComboDashPtList.List(x, 2) = Format(rs.Fields("DOB").Value, "MM\/dd\/yyyy") & ""
F1.ComboDashPtList.List(x, 3) = rs.Fields("MedNumber").Value & ""
rs.MoveNext
x = x + 1
Wend
rs.Close
Exit Sub`
'....
This is an example of how I send my data back to Access (again picking up mid-Sub).
` Set Conn = New ADODB.Connection
Set rs = New ADODB.Recordset
Conn.Open (strConn)
rs.Open strDBPtInfo, strConn, adOpenKeyset, adLockOptimistic, adCmdTable
rs.AddNew
rs!MedNumber = strMedNum
rs!LastName = strLastName
rs!Firstname = strFirstName
rs!DOB = dtDOB
rs.Update `
'....
Sometimes I need to completely overwrite or add to a specific field in a certain Access table. For years 'someone may have an allergy to penicillin, but suddenly they are also allergic to codeine, so that has to 'be updated. This is the approach I've taken but I keep getting an error:
'....
` Set Conn = New Connection
Set rs = New Recordset
Conn.Open (strConn)
strUpdateqry = "SELECT * FROM tblMedHxInfo WHERE MedNumber = " & Chr(34) & strMedNum & Chr(34) & ""
rs.Open strUpdateqry, strConn, adOpenKeyset
rs!Allergies = "Penicillin, Codeine"
rs.Update
If rs.State = 1 Then rs.Close
If Conn.State = 1 Then Conn.Close
Set rs = Nothing
Set Conn = Nothing`
....
This is the Error:
"Run-time error '3251': Current Recordset does not support updating.
This may ne a limitation of the provider, or of the selected locktype"
'Any help would be greatly appreciated!
'Thanks,
'Derek
'I've tried using the recordset to create a temporary table and then use that to update but it's getting over my head
Explicitly declare connection and recordset type. Then Set lines are not required.
Set the lock type argument.
Reference connection object not string variable for opening recordset.
Dim cn As ADODB.Connection, rs As ADODB.Recordset
cn.Open (strConn)
strUpdateqry = "SELECT * FROM tblMedHxInfo WHERE MedNumber = " & Chr(34) & strMedNum & Chr(34)
rs.Open strUpdateqry, cn, adOpenKeyset, adLockOptimistic
rs.Update "Allergies", "Penicillin, Codeine"
Or instead of opening recordset object for insert or update:
Dim cn As ADODB.Connection
cn.Open (strConn)
cn.Execute "UPDATE tblMedHxInfo SET Allergies = 'Penicillin, Codeine' WHERE MedNumber='" & strMedNum & "'"
I'm trying to learn how to connect to a SQL Server DB from Excel DB. I've tried to reduce the code to dead simple to begin with. I've looked at several answers to related questions, however, I cannot figure out why this doesn't work. It executes all the way through. (The code shown here is somewhat anonymized.)
The query finds the database, because if the table name is invalid it throws an error. However it always returns record count = -1. I can eyeball the table in MSSMS and it has data. Same result for other tables in the DB.
Public Sub ADOtest1()
Dim Conn As ADODB.Connection
Dim rs As ADODB.Recordset
Dim strConnString As String
strConnString = "Provider='SQLOLEDB'" & ";" & _
"Data Source='XXX-XPS\SQLEXPRESS'" & ";" & _
"Initial Catalog='XXXXX'" & ";" & _
"Integrated Security='SSPI'"
Set Conn = New ADODB.Connection
Conn.Open strConnString
' the query finds the DB, because if the table name is incorrect, it throws an error
strSQLString = "SELECT * from t300_XXXX"
Set rs = Conn.Execute(strSQLString)
wrkRecordCount = rs.RecordCount
'--- just some test breakpoints
If wrkRecordCount = -1 Then
a = "" '--- code keeps arriving here
Else
a = ""
End If
rs.Close
Conn.Close
End Sub
Answer from Srinika below worked:
Set rs = Conn.Execute(strSQLString)
rs.Close
rs.CursorLocation = adUseClient
rs.Open
I'll post two examples, so please refer.
First Example
Sub ExampleSQL()
Dim cnn As ADODB.Connection
Dim rs As ADODB.Recordset
Dim strSQL As String
Set cnn = New ADODB.Connection
'Set the provider property to the OLE DB Provider for ODBC.
'cnn.Provider = "MSDASQL"
'cnn.Provider = "Microsoft.ACE.OLEDB.12.0"
'cnn.Provider = "MSOLAP"
'cnn.Provider = "SQLOLEDB.1"
' Open a connection using an ODBC DSN.
cnn.ConnectionString = "driver={SQL Server};" & _
"server=severname;uid=sa;pwd=password;database=test"
Set rs = New ADODB.Recordset
strSQL = "SELECT * FROM [your Table] "
rs.Open strSQL, cnn.ConnectionString, adOpenForwardOnly, adLockReadOnly, adCmdText
cnn.Open
If cnn.State = adStateOpen Then
Else
MsgBox "Sever is not connected!! "
Exit Sub
End If
If Not rs.EOF Then
With Ws
.Range("a4").CurrentRegion.ClearContents
For i = 0 To rs.Fields.Count - 1
.Cells(4, i + 1).Value = rs.Fields(i).Name
Next
.Range("a5").CopyFromRecordset rs
.Columns.AutoFit
End With
Else
MsgBox "No Data!!", vbCritical
End If
rs.Close
Set rs = Nothing
cnn.Close
Set cnn = Nothing
End Sub
Second Example
Sub getDataFromServer()
Dim con As New ADODB.Connection
Dim cmd As New ADODB.Command
Dim rs As New ADODB.Recordset
Dim i As Integer
con.ConnectionString = "Provider=SQLOLEDB.1;" _
& "Server=(local);" _
& "Database=TEST;" _
& "Integrated Security=SSPI;" _
& "DataTypeCompatibility=80;"
con.Open
Set cmd.ActiveConnection = con
cmd.CommandText = "SELECT * FROM [your Table]"
Set rs = cmd.Execute
Range("A1").CopyFromRecordset rs
con.Close
Set con = Nothing
End Sub
Disclaimer: I am new to VBA.
I hope to pass the value in the SQL query (30881570) through a field on my Excel sheet. I have tried a few different things.
Private Sub cmdImport_Click()
Call cmdClear_Click
Dim conn As New ADODB.Connection, cmd As New ADODB.Command, rs As New ADODB.Recordset
With conn
.ConnectionString = _
"Provider=SQLOLEDB; " & _
"Data Source=PRGTAPPDBSWC019; " & _
"Initial Catalog=DETEP;" & _
"Integrated Security=SSPI;"
.Open
End With
With cmd
.ActiveConnection = conn
.CommandText = "SELECT * FROM [dbo].[tbl_PMHeader] WHERE [PMHeader_PM_NUM] = '30881570'"
.CommandType = adCmdText
End With
Set rs.Source = cmd
rs.Open
'Need this to populate header row, starting at specified Range
For intColIndex = 0 To rs.Fields.Count - 1
Range("B1").Offset(0, intColIndex).Value = rs.Fields(intColIndex).Name
Next
'This is where your data table will be copied to
ActiveSheet.Range("B2").CopyFromRecordset rs
Worksheets("Sheet1").Columns("B:BB").AutoFit
Worksheets("Sheet1").Range("A25").Formula = "=COUNTA(B:B)-1"
End Sub
It looks like you're already passing that value as criteria for the query's WHERE statement.
If you're asking how to replace that with a value from a worksheet, here's one way:
.CommandText = "SELECT * FROM [dbo].[tbl_PMHeader] " & _
"WHERE [PMHeader_PM_NUM] = '" & Sheets("mySheet").Range("A1") & "'"
...where your worksheet is named mySheet and the value is in cell A1.
This is the simplest method, potentially fine for internal use by trusted parties, but if the value has any ' single-quotes in it, you will get an error.
Worst-case scenario, this method leaves you open to SQL Injection attacks. Depends on your needs (and whether this this is just a school assignment), you may be better of using a parameter query.
See Also:
MSDN Blog : How and Why to Use Parameterized Queries
MSDN Blog : Everything About Using Parameters from Code
Private Sub cmdImport_Click()
Dim conn As New ADODB.Connection
Dim cmd As New ADODB.Command
Dim rs As New ADODB.Recordset
Dim sqlStr As String
With conn
.ConnectionString = _
"Provider=SQLOLEDB; " & _
"Data Source=PRGTAPPDBSWC019; " & _
"Initial Catalog=DETEP;" & _
"Integrated Security=SSPI;"
.Open
End With
orderno = Sheets("Sheet1").Range("A22")
strSql = "SELECT * FROM [dbo].[tbl_PMHeader] " & _
"WHERE [PMHeader_PM_NUM] = " & orderno
With cmd
.ActiveConnection = conn
.CommandText = strSql
.CommandType = adCmdText
End With
'Call cmdClear_Click
Set rs.Source = cmd
rs.Open
'Need this to populate header row, starting at specified Range
For intColIndex = 0 To rs.Fields.Count - 1
Range("B1").Offset(0, intColIndex).Value = rs.Fields(intColIndex).Name
Next
'This is where your data table will be copied to
ActiveSheet.Range("B2").CopyFromRecordset rs
Worksheets("Sheet1").Columns("B:BB").AutoFit
Worksheets("Sheet1").Range("A25").Formula = "=COUNTA(B:B)-1"
End Sub
This is the code I use to open a connection to an access database from excel. It used to work for more than a year.
Set dbname = New ADODB.Connection
theconnection = "//xxx.sharepoint.com/sites" & Application.PathSeparator & TARGET_DB
With dbname
.Provider = "Microsoft.ACE.OLEDB.12.0"
.Open theconnection
End With
By trial an error I've come to the conclusion that this line is causing the problem.
Set dbname= New ADODB.Connection
The problem began after an automatic update of my PC
My Excel version 2016 MSO (16.0.7726.1036) 32-bit
Please let me know if you have run also into this problem, and if you know any fix or workaround.
try to uncheck your 'ActiveX Data Objects' references and add them back:
Tools - References
or
use object to define a database:
Dim dbname As Object
Set dbname = CreateObject("ADODB.Connection")
or
if you create connection variable like this:
Dim con as New ADODB.Connection
change it to:
Dim con as ADODB.Connection
Set con = New ADODB.Connection
Maybe
Dim dbname As Object
Set dbname = CreateObject("ADODB.Connection")
theconnection = "//xxx.sharepoint.com/sites" & Application.PathSeparator & TARGET_DB
With dbname
.Provider = "Microsoft.ACE.OLEDB.12.0"
.Open theconnection
End With
I used like this , all code
Dim Rs As Object
Dim strConn As String
Dim i As Integer
Dim strSQL As String
strSQL = "select * from [table] "
strConn = "Provider=Microsoft.ACE.OLEDB.12.0;" & _
"Data Source=" & ThisWorkbook.FullName & ";" & _
"Extended Properties=Excel 12.0;"
Set Rs = CreateObject("ADODB.Recordset")
Rs.Open strSQL, strConn
If Not Rs.EOF Then
With Ws
.Range("a1").CurrentRegion.ClearContents
For i = 0 To Rs.Fields.Count - 1
.Cells(1, i + 1).Value = Rs.Fields(i).Name
Next
.Range("a" & 2).CopyFromRecordset Rs
End With
End If
Rs.Close
Set Rs = Nothing
I'd like to query an Excel worksheet in VBA and specify conditions.
The simple query "SELECT * FROM [PCR$]" works perfectly, but I don't know how to add a WHERE clause.
I tried cmd2.CommandText = "SELECT * FROM [PCR$] WHERE ([B1] IS NOT NULL)" but then it complains about missing parameters.
This is the complete code:
Dim rs2 As New ADODB.Recordset
Dim cnn2 As New ADODB.Connection
Dim cmd2 As New ADODB.Command
Dim intField As Integer
Dim strFile As String
strFile = fncOpenFile
If strFile = "" Then Exit Sub
With cnn2
.Provider = "Microsoft.Jet.OLEDB.4.0"
.ConnectionString = "Data Source='" & strFile & "'; " & "Extended Properties='Excel 8.0;HDR=Yes;IMEX=1'"
.Open
End With
Set cmd2.ActiveConnection = cnn2
cmd2.CommandType = adCmdText
cmd2.CommandText = "SELECT * FROM [PCR$]"
rs2.CursorLocation = adUseClient
rs2.CursorType = adOpenDynamic
rs2.LockType = adLockOptimistic
rs2.Open cmd2
In your connection string you say
Excel 8.0;HDR=Yes
Which means that the first row will be treated as the header, no matter what it contains. If you want to use F1, F2 etc, say
Excel 8.0;HDR=No
Because you have the HDR=Yes option, the column name should be the data in the first row.
http://support.microsoft.com/kb/316934