I have built a macro, wherein data is first imported into 'Raw' worksheet. Before importing, 'Raw' sheet is first cleared of previous data.
Then i query it using SQL in VBA and get the final output in desired format.
Lately i have been facing an issue, which gives a error message "The Connection for viewing your linked Microsoft Excel Worksheet was lost".
The same macro works fine if i dont clear the 'Raw' sheet before importing data.
Any help is appreciated.
Option Explicit
Public ROW As Integer
Public Cnn As New ADODB.Connection
Public Rs As New ADODB.Recordset
Public StrSQL As String
Public Sub OpenDB()
If Cnn.State = adStateOpen Then Cnn.Close
Cnn.ConnectionString = "Driver={Microsoft Excel Driver (*.xls, *.xlsx, *.xlsm, *.xlsb)};DBQ=" & _
ActiveWorkbook.Path & Application.PathSeparator & ThisWorkbook.Name
Cnn.Open
End Sub
Public Sub CloseRS()
If Rs.State = adStateOpen Then Rs.Close
Rs.CursorLocation = adUseClient
End Sub
Sub MonthlyYorN()
StrSQL1 = "SELECT * FROM [RAW$] where SOME CONDITION"
StrSQL1 = "SELECT * FROM [RAW$] where SOME CONDITION2"
StrSQL = StrSQL1 & " UNION " & StrSQL2
CloseRS
OpenDB
Rs.Open StrSQL, Cnn, adOpenKeyset, adLockOptimistic
If Rs.RecordCount > 0 Then
'Do Something
End If
End Sub
This is not a VBA issue, it's a problem with the ODBC Driver. Go to →ODBC to open Data Sources, then into the Advanced Settings for the Excel ODBC Driver, and make sure to turn on checkbox:
☑ Enable Automatic Reconnect
MS Access ODBC can experience the same problem, fixed the same way.
Related
I am trying to import a CSV file split by semicolon ";" into an excel object so I can use it later on.
Ideally i would like to use ADO, DAO or ADODB so I can also run SQL queries on the object, and get sum of specific fields, or total number of fields and so on.
So far i've gotten the code below, but it does not split the data by ";", so it all comes back as 1 field instead of multiple fields that can be handled.
Sub Import()
Dim conn As New ADODB.Connection
Dim rs As New ADODB.Recordset
Dim f As ADODB.Field
Dim csvName, csvPath
csvPath = ActiveWorkbook.path
csvName = "fileName.csv"
conn.Open "DRIVER={Microsoft Text Driver (*.txt; *.csv)};DBQ=" & csvPath & ";"
rs.Open "SELECT * FROM " & csvName, conn, adOpenStatic, adLockReadOnly, adCmdText
Debug.Print rs.Fields
While Not rs.EOF
For Each f In rs.Fields
Debug.Print f.Name & "=" & f.Value
Next
Wend
End Sub
Can anyone give me an idea how I can also split the data by ";" and query it using SQL query? Or a different object that I could load a CSV into and query certain columns.
Here's example:
Public Sub QueryTextFile()
Dim rsData As ADODB.Recordset
Dim sConnect As String
Dim sSQL As String
' Create the connection string.
sConnect = "Provider=Microsoft.ACE.OLEDB.12.0;" & _
"Data Source=C:\Files\;" & _
"Extended Properties=Text;"
' Create the SQL statement.
sSQL = "SELECT * FROM Sales.csv;"
Set rsData = New ADODB.Recordset
rsData.Open sSQL, sConnect, adOpenForwardOnly, _
adLockReadOnly, adCmdText
' Check to make sure we received data.
If Not rsData.EOF Then
' Dump the returned data onto Sheet1.
Sheet1.Range("A1").CopyFromRecordset rsData
Else
MsgBox "No records returned.", vbCritical
End If
' Clean up our Recordset object.
rsData.Close
Set rsData = Nothing
End Sub
The only answer I found that was usable was to create an ini file in the current folder, and enter the delimiter in the ini file.
iniPath = activeworkbook.path & "\"
iniName = "schema.ini"
iniPathName = iniPath & iniName
If Not fso.FileExists(iniPathName) Then
fso.CreateTextFile (iniPathName)
End if
Hi im pretty new to VBA and im trying to build a connection with a database protected by a password. This is my code.
Sub CostEntry()
ActiveWorkbook.Sheets.Add.Name = "SAP Sheet"
sConnString = "SourceType:=0, Source:=ODBC;DSN=SAPDATA32;Description=DATA;UID=shareuser;Jet OLEDB:Database Password=1234;APP=Microsoft Office 2016;WSID=AT;DATABASE=DATA"
' Create the Connection and Recordset objects.
Set conn = New ADODB.Connection
Set rs = New ADODB.Recordset
' Open the connection and execute.
conn.Open sConnString
Set rs = conn.Execute("SELECT MBEW.BWKEY, MBEW.STPRS, MBEW.MATNR" & Chr(13) & "" & Chr(10) & "FROM SAPDATA.dbo.MBEW MBEW" & Chr(13) & "" & Chr(10) & "WHERE (MBEW.BWKEY='1010')")
' Check we have data.
If Not rs.EOF Then
' Transfer result.
ActiveWorkbook.Sheets("SAP Sheet").range("A1").CopyFromRecordset rs
' Close the recordset
rs.Close
Else
MsgBox "Error: No records returned.", vbCritical
End If
' Clean up
If CBool(conn.State And adStateOpen) Then conn.Close
Set conn = Nothing
Set rs = Nothing
End Sub
Most of it i also copied from the internet adn i also think it was from stackoverflow. I alwas get the error message "Run-time error '-2147467259 (8000400)': Could not find installable ISAM". I trie inserting the line Provider=Microsoft.ACE.OLEDB.12.0
but it just gave me another error message.
Thnak you all in advance.
Try providing single quotes for the property value
Provider='Microsoft.ACE.OLEDB.12.0'
Found out i just needed to add a PW:1234 field
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 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.
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