I was trying to use SQL queries to work with my excel sheets as tables. I wrote the following code:
Global objConn As ADODB.Connection
Global ConnString As String
Global SQL As String
Global objRS As ADODB.Recordset
Global masterFile As String
Public Sub XL_DB_connect()
Set objConn = New ADODB.Connection
masterFile = ThisWorkbook.Path & Application.PathSeparator & ThisWorkbook.Name
ConnString = "Provider=Microsoft.ACE.OLEDB.12.0;" & _
"Data Source=" & masterFile & ";" & _
"Extended Properties=""Excel 12.0;" & _
"HDR=Yes;"";"
objConn.ConnectionString = ConnString
objConn.Open
End Sub
Public Sub executeQuery()
objRS.Source = SQL
objRS.ActiveConnection = objConn
objRS.Open
End Sub
Public Sub XL_DB_relMem()
Set objRS = Nothing
Set objConn = Nothing
SQL = vbNullString
End Sub
Public Sub test()
Set objRS = New ADODB.Recordset
objRS.CursorLocation = adUseClient
SQL = "select PatientGID, count(LOT) from [Sheet1$] group by PatientGID"
Debug.Print SQL
Call XL_DB_connect
Call executeQuery
objRS.MoveFirst
Range("Output").Resize(10, 2).ClearContents
Range("Output").CopyFromRecordset objRS
End Sub
Sheet1 has the following columns starting from cell A1
patientGID
progression
loT
newLoT
loTFdate
actualRegimen
loTRegimenClass
progressionClass
pERMetFlag
On running the code, I get following error:
"Run-time error '-2147467259 (80004005)'
'Sheet1$' is not a valid name. Make sure that it does not include
invalid characters and punctuation and that it is not too long"
I got the same error today. I found that the reason was the excel file was in its read-only status. When I saved it in another location, the error was immediately fixed.
Related
I'm trying to write some VBA that can query a named range in VBA using SQL. Currently, it works reasonably well, but i have the problem that every time i run the macro a read-only instance of the worksheet is opened. I want to use the macro to query ranges within the same workbook without opening a read-only copy.
Here is my code
Public Sub QueryAndOutputToCell(ByVal query As String, rng As Range)
Dim conn As ADODB.Connection
Set conn = New ADODB.Connection
Dim DBFullName, connString, SQL As String
DBFullName = ThisWorkbook.path & "\" & ThisWorkbook.name
connString = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source='" & DBFullName & "';Extended Properties='Excel 12.0;HDR=Yes;IMEX=1';"
conn.connectionString = connString
conn.Open ' Read-only copy is opened here
conn.commandtimeout = 0
Dim cubeData As ADODB.Recordset
Set cubeData = New ADODB.Recordset
cubeData.Open query, conn, adOpenDynamic, adLockReadOnly
rng.CopyFromRecordset cubeData
cubeData.Close
conn.Close
Set cubeData = Nothing
Set conn = Nothing
End Sub
Do anyone know if this is possible?
I cant seem to find an easy way of doing outside of just accessing the SQL from ACCESS SQL View and doing it manually. Is there some magic way to use this code below and do that?
Its worth pointing out that I am trying to do this from Excel's VBA.
Private Sub tryagain()
Dim con As ADODB.Connection
Dim rs As ADODB.Recordset
Set con = New ADODB.Connection
With con
.Provider = "Microsoft.ACE.OLEDB.12.0"
.Open "C:\Users\Ashleysaurus\Desktop" & "\" & "xyzmanu3.accdb"
End With
con.Execute "Invoice Query"
'How do output to Worksheet?
rs.Close
cmd.ActiveConnection.Close
End Sub
Simply use the ADO recordset object which you initialize, call the query, and then run the Range.CopyFromRecordset method (specifying the leftmost worksheet cell to place results).
Also, see the changed connection open routine with proper connection string. And because recordsets do not pull in column headers automatically but only data, an added loop was included iterating through recordset's field names.
Private Sub tryagain()
Dim con As New ADODB.Connection
Dim rs As New ADODB.Recordset
Dim strConnection As String
Dim i as Integer, fld As Object
strConnection = "Provider=Microsoft.ACE.OLEDB.12.0;" _
& "Data Source='C:\Users\Ashleysaurus\Desktop\xyzmanu3.accdb';"
con.Open strConnection
rs.Open "SELECT * FROM [Invoice Query]", con
' column headers
i = 0
Sheets(1).Range("A1").Activate
For Each fld In rs.Fields
ActiveCell.Offset(0, i) = fld.Name
i = i + 1
Next fld
' data rows
Sheets(1).Range("A2").CopyFromRecordset rs
rs.Close
cn.Close
End Sub
By the way, this same above setup can even query Excel workbooks as the Jet/ACE SQL Engine is a Windows technology (.dll files) available to all Office or Windows programs.
strConnection = "Provider=Microsoft.ACE.OLEDB.12.0;" _
& "Data Source='C:\Path\To\Workbook.xlsm';" _
& "Extended Properties=""Excel 8.0;HDR=YES;"";"
strSQL = "SELECT * FROM [Sheet1$]"
I don't know why Excel - VB is behaving stupidly. My tool has several user forms. Everything was working fine until I renamed a command button's caption. I am getting a Type miss-match error. The command loads another form. The form_initialise code is below. when I commented out all of the code the code in userform_initialise it works fine, but when remove the comment ' from all the lines it give me an error Type Mismatch.
Earlier it was working perfect and my company is using it as well. Can anyone help.
Private Sub UserForm_initialize()
lstUser.AddItem Sheets("LAUNCH").Range("Z1").Value
Application.ScreenUpdating = False
Dim conn As Object
Dim rs As Object
Dim objMycmd As Object
Dim rc As Long
Dim sConnString As String
' Create the connection string.
sConnString = "Provider=SQLOLEDB;Data Source=XXXXXXXX;" & _
"Initial Catalog=XXXXXX;" & _
"Integrated Security=XXXXXXXX;" & _
"User ID=XXXXXXXXXXXXXXXX;" & _
"Passsword=XXXXXXXXXXXXXXXXX;"
' Create the Connection and Recordset objects.
Set conn = CreateObject("ADODB.Connection")
' Open the connection and execute.
conn.Open sConnString
Sql = "Select DISTINCT [Exec] from tblKPI3"
Set rs = CreateObject("ADODB.Recordset")
rs.Open Sql, conn, adOpenStatic
If rs.EOF Then
MsgBox "No Records"
Else
rs.Movefirst
If Sheets("LAUNCH").Range("AA1") = "Yes" Then
With frmReport.lstUser
.Clear
Do
.AddItem rs![exec]
rs.MoveNext
Loop Until rs.EOF
End With
End If
End If
rs.Close
conn.Close
end sub
I have a class ADOConnector for creating an ADODB connection to a workbook and querying the workbook:
Private objconnection As New ADODB.Connection
Sub connect(workbookPath As String)
On Error GoTo errHandler
objconnection.CommandTimeout = 99999999
objconnection.Open "Provider=Microsoft.ACE.OLEDB.12.0;" & _
"Data Source=" & workbookPath & ";" & _
"Extended Properties=""Excel 12.0 Xml;HDR=YES;IMEX=1"";"
Exit Sub
errHandler:
Err.Raise Err.Number, "ADOConnector.connect", Err.Description & _
" (" & workbookPath & ")"
End Sub
Function WorksheetQuery(selectSQL As String) As ADODB.Recordset
Dim objrecordset As New ADODB.Recordset
Const adOpenStatic = 3
Const adLockOptimistic = 3
Const adCmdText = &H1
objrecordset.Open selectSQL, _
objconnection, adOpenStatic, adLockOptimistic, adCmdText
If objrecordset.EOF Then
Set WorksheetQuery = Nothing
Exit Function
End If
Set WorksheetQuery = objrecordset
Exit Function
errHandler:
Err.Raise Err.Number, "ADOConnector.WorksheetQuery", Err.Description
Set WorksheetQuery = Nothing
End Function
I have a test method for WorksheetQuery:
Sub testADOcon()
Dim ac As New ADOConnector
Dim bkPath as string
bkPath = "U:\testFolder\testWorkbook.xlsx"
ac.connect bkPath
Dim rs As ADODB.Recordset
Set rs = ac.WorksheetQuery("select distinct * from [report$]")
End Sub
This method gives strangely inconsistent results:
If the workbook at bkPath is open, it fails with this error: The connection for viewing your linked Microsoft Excel worksheet was lost.
If the workbook at bkPath is closed, it executes successfully.
If bkPath is set as bkPath = ThisWorkbook.FullName, it executes successfully.
If the SQL is changed to "select * from [report$]", it executes successfully regardless of whether the workbook is open or closed.
How can I use distinct on another open workbook?
So my problem is that between 2 different computers my connection to the string no longer can open a connection.
Here is what I have:
Dim sFileName As String
Dim sFilePath As String
sFileName = "DataSource.xls"
sFilePath = "C:\test\testingData\"
Dim sConn As String
sConn = "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=" & sFilePath & sFileName & ";" & _
"Extended Properties=""Excel 8.0;HDR=Yes"";"
Dim errorObject As ADODB.Error
Set errorObject = CreateObject("ADODB.Error")
On Error GoTo ErrorDisplay:
Dim conn As ADODB.Connection
Set conn = New ADODB.Connection
conn.Open sConn
Dim rst As ADODB.Recordset '* Record Set
Set rst = New ADODB.Recordset
rst.Open sSql, conn, adOpenForwardOnly
Worksheets(1).Range("A2").CopyFromRecordset rst
sSQL = "SELECT * FROM [MySheet$] WHERE [Status] = 2 AND [DocNo] LIKE '%-A%'
When I run this section of code on one computer it runs perfectly as I built it. When I try it on a similar computer it keeps giveing an error "Object variable or With Block variable not set". I have found out that the problem is with the conn.Open sConn but not sure what is causing it.
I have been searching about looking for a solution but as of yet I have not found anything that worked.
Additional Info:
Both computers:
Windows 7 x64
Excel 2007 x32
Any thoughts as to why this would not work?
--Update:
I just finished trying the excel file with the macro out on a 3rd windows 7 computer and that one works fine.
--Update:
I have just tried running the program from
sFilePath = "C:\Users\FirstName.LastName\Desktop\"
and
sFilePath = "C:\Users\FirstName.LastName\Desktop\Test\"
The thing I would really like to know is that it's working from the "C:\Users\FirstName.LastName\Desktop\Test\" but none of the others???
Are you sure that the Primary Interop Assemblies are installed on both computers?
You may try below code.
' Add reference to Adodb library
Dim conn As ADODB.Connection
Public Function CreateConnection() As Boolean
On Error GoTo ErrorRet
Dim X As Integer
Dim sConn As String
Dim sFileName As String
Dim sFilePath As String
X = 0
Reconn:
X = X + 1
sFileName = "DataSource.xls"
sFilePath = "C:\test\testingData\"
sConn = "Provider=Microsoft.ACE.OLEDB.12.0;" & _
"Data Source=" & sFilePath & sFileName & ";" & _
"Extended Properties=""Excel 8.0;HDR=Yes"";"
Set conn = New ADODB.Connection
conn.Open sConn
CreateConnection = True
Exit Function
ErrorRet:
If Err.Number = -2147467259 Then
GoTo Reconn
Else
If X > 5 Then
CreateConnection = False
Else
GoTo Reconn
End If
End If
End Function
Sub test()
Dim sSql As String
Dim rst As ADODB.Recordset
Set rst = New ADODB.Recordset
If CreateConnection Then
sSql = "SELECT * FROM [MySheet$]"
rst.Open sSql, conn
Worksheets(1).Range("A2").CopyFromRecordset rst
End If
End Sub