I have two Excel files, a master file and a regular file. Both files have a sheet with the same data structure (same fields, but not formatted as tables).
What I'm trying to do is use VBA to create data connections to both files, and then use SQL to update the master file with any changes in the regular file. The reason for using SQL and a data connection is to avoid opening the regular file and hopefully faster performance overall.
I'm having difficulty with the UPDATE statement, and I'm not sure I'm even going about this in the best manner. My code thus far:
Sub Main()
Dim cnn1 As New ADODB.Connection
Dim cnn2 As New ADODB.Connection
Dim rst1 As New ADODB.Recordset
Dim rst2 As New ADODB.Recordset
Dim arrData() As Variant
Dim fPath As String
With Application.FileDialog(msoFileDialogFilePicker)
.AllowMultiSelect = False
.Filters.Add "Files", "*.xls*"
.InitialFileName = ThisWorkbook.Path & "/Meeting Cuts"
.Title = "Please select the file that contains the values you'd like to import."
.Show
fPath = .SelectedItems(1)
End With
DoEvents
cnn1.Open "Provider=Microsoft.ACE.OLEDB.12.0;" & "Data Source=" & CStr(fPath) & ";" & "Extended Properties=""Excel 12.0;HDR=Yes;"";"
cnn2.Open "Provider=Microsoft.ACE.OLEDB.12.0;" & "Data Source=" & CStr(ThisWorkbook.FullName) & ";" & "Extended Properties=""Excel 12.0;HDR=Yes;"";"
rst1.Open "SELECT * FROM [Sheet1$];", cnn1, adOpenStatic, adLockReadOnly
rst2.Open "UPDATE [Account Data$]" & _
"SET Account_ID = (SELECT Account_ID FROM " & rst1.GetRows & " WHERE Empl_Name = 'Smith,John')" & _
"WHERE Empl_Name = 'Smith,John'", cnn2, adOpenStatic, adLockReadOnly
Set rst1 = Nothing
Set rst2 = Nothing
Set cnn1 = Nothing
Set cnn2 = Nothing
End Sub
When I execute the code, I get a Run-time error '13': Type Mismatch on the rst2.Open line. When I go into debug mode and try to execute that line again, I get a different error: Run-time error '3021': Either BOF or EOF is True, or the current record has been deleted. Requested operation requires a current record.
I know that I'm using GetRows improperly. Is there a way to reference the sheet (from the regular file) somehow in the UPDATE statement? If so, how would I do it?
Related
I have a SQL query stored in one of my excel sheet cells that I execute using the below VBA Code:
Sub run()
Dim dtStart As Date
Dim dtEnd As Date
Dim MRC As Variant
'Get the SQL text(s)
MRC = "" & Worksheets("SQL Text").Range("D4").Value & ""
'Check for UNDF queries
If MRC = 0 Then
MsgBox ("Query has not yet been defined, please make a new selection")
Exit Sub
Else
End If
'Set up query
Application.StatusBar = "Data Refresh: 1 of 1 "
'Update subTabs
Sheets("Summary").Select
With ActiveWorkbook.Connections("connection1").OLEDBConnection
.CommandText = MRC
.CommandType = xlCmdSql
End With
ActiveWorkbook.Connections("connection1").Refresh
End Sub
In addition to the above VBA code, I also have another VBA code that executes the different SQL view and transfers the SQL view result-set to a .txt file and saves it into a specific folder. Please see below for that code
Sub TEXT()
Dim cn As New ADODB.Connection
Dim rs As New ADODB.Recordset
Dim strCon, strSQL As String
strCon = "Provider=SQLOLEDB.1;" & _
"Integrated Security=SSPI;Persist Security Info=True;" & _
"Initial Catalog=master;Data Source=VRSQLADHOC;" & _
"Use Procedure for Prepare=1;" & _
"Auto Translate=True;" & _
"Packet Size=4096;" & _
"Use Encryption for Data=False;" & _
"Tag with column collation when possible=False"
strSQL = "SELECT * FROM table1" 'Sql Query
Folder = "U:\" 'Path in U drive
Filename = "file_name_" & Format(Now(), "YYYYMMDD") & ".txt" 'Name of Text document
fpath = Folder & Filename
cn.Open strCon
rs.ActiveConnection = cn
rs.Open strSQL
Set fs = CreateObject("Scripting.FileSystemObject")
Set A = fs.CreateTextFile(fpath)
A.Write (rs.GetString(adClipString, , , vbCrLf, ""))
rs.Close
cn.Close
Set cn = Nothing
MsgBox ("file name " + fpath)
End Sub
Currently I am interested in applying the second VBA logic of transferring the result-set data into .txt file to my first VBA logic, which takes care of executing the SQL query stored in one of the excel sheet cells.
To put it shortly I want to execute a SQL query stored in an excel cell and then transfer the result set into a .txt file
If I'm understanding this right, both these subs use really different ways do query the database.
In the first example you've got a db connection in a sheet, and you're using a cell to update that connection.
In the second, you've got a vba /adodb connection to the database. If all you want to do is refer to a cell in excel for the query, then simply change the line:
strSQL = "SELECT * FROM table1" 'Sql Query
to something more like:
strSQL = Worksheets("SQL Text").Range("D4").Value
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
I am trying to use SQL in VBA to update data in an existing table in Excel (same file as vba code). This is being written with SQL queries and updating with the intent of moving the source data to a DB shortly after rollout, but there are reasons why not right now. I keep getting the error "Operation must use an updateable query." Some sources show ReadOnly in the Extended Properties and some do not; both have been tried. StatusData is a named range in the Excel file. SELECT statements using the named range are working fine using the following connection string:
DBFullName = ThisWorkbook.Path & "\" & ThisWorkbook.Name
Cnct = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source='" & DBFullName & "';" & _
"Extended Properties='Excel 12.0;HDR=Yes;IMEX=1';"
Changes from the query connection include using the "Excel 12.0 Macro" extended property and ReadOnly=0, which have been incrementally. Broken code is as follows:
Cnct = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source='" & DBFullName & "';" & _
"Extended Properties='Excel 12.0 Macro;ReadOnly=0;HDR=Yes;IMEX=1';"
Set Cn = New ADODB.Connection
Cn.Open ConnectionString:=Cnct
strSQL = "UPDATE StatusData SET Notes='ttt' WHERE [Program Category]='something' AND [Program Name]='something' AND [LN]='1' AND [SN]='101';"
Cn.Execute strSQL, RecordsAffected, adExecuteNoRecords
I had problems using IMEX so in the end I stopped using it for this purpose, this connection string has never given me problems for using ADO/ACE to connect back to the workbook (usually for a SQL GroupBy), but you might need to do some conditioning on the data before making the connection (I take the entire table into an array and loop though the fields making changes as needed, then dump back to the sheet), easy enough as its already in the same workbook of course:
Dim conn As Object
Dim sPath As String
sPath = "C:\offlinestorage\temp1.xlsx"
Set conn = CreateObject("ADODB.Connection")
With conn
.Provider = "Microsoft.ACE.OLEDB.12.0"
.ConnectionString = Format("Data Source=" & sPath & ";Extended Properties='Excel 12.0 XML;HDR=Yes';")
.Open
End With
After this question: get value/charts in another workbooks without opening it
I have coded this:
Sub test()
Dim oConn As New ADODB.Connection
Dim rst As New ADODB.Recordset
oConn.Provider = "Microsoft.Jet.OLEDB.4.0"
oConn.Properties("Extended Properties").Value = "Excel 8.0"
oConn.Open "C:\Workbook1.xlsm"
rst.Open "SELECT * FROM [A1:A2];", oConn, adOpenStatic
rst.MoveFirst
MsgBox rst.Fields(0)
rst.Close
oConn.Close
End Sub
For the moment my goal is to get the value in the cell A1 of the sheet 1 of workbook1.xlsm.
I've encountered two problems.
When the workbook1 is not opened I got a
Run time error '-214767259 (80004005)': Automation error Unspecified Error on the line oConn.Open "C:\Workbook1.xlsm`
This is annoying because I want to work without opening the workbooks. It works well when the workbook is open.
Second problem: I can't manage to only get a single cell value. I've tried to input only [A1] in rst.open but it doesn't work. How can I get a unique cell value with its address ? with its name ?
If you don't mind I'll provide you a bit different attempt to get your data. The difference is the way you connect with you database (excel sheet). However, you could possibly incorporate some important elements into your code. So, check comments inside the code below.
Sub Closed_excel_workbook()
Dim myConnection As String
Dim myRecordset As ADODB.Recordset
Dim mySQL As String
'connection string parameters
'CHANGE PATH TO YOUR CLOSED WORKBOOK
myConnection = "Provider=Microsoft.ACE.OLEDB.12.0;" & _
"Data Source=" & ThisWorkbook.Path & "\Dane\BazaDanych.xlsx;" & _
"Extended Properties=Excel 12.0"
'here is important, YOU CAN'T MISS SHEET NAME
mySQL = "SELECT * FROM [ARKUSZ1$a1:a2]"
'different way of getting data from excel sheet
Set myRecordset = New ADODB.Recordset
myRecordset.Open mySQL, myConnection, adOpenUnspecified, adLockUnspecified
'let's clear sheet before pasting data
'REMOVE IF NOT NEEDED
ActiveSheet.Cells.Clear
'HERE WE PASTING DATA WE HAVE RETRIEVED
ActiveSheet.Range("A2").CopyFromRecordset myRecordset
'OPTIONAL, IF REQUIRED YOU CAN ADD COLUMNS NAMES
Dim cell As Range, i!
With ActiveSheet.Range("A1").CurrentRegion
For i = 0 To myRecordset.Fields.Count - 1
.Cells(1, i + 1).Value = myRecordset.Fields(i).Name
Next i
.EntireColumn.AutoFit
End With
End Sub
My solution:
Function GetValue()
Path = "C:\Path\"
File = "Doc.xlsm"
Sheet = "Sheet_name"
Ref = "D4"
'Retrieves a value from a closed workbook
Dim Arg As String
'Make sure the file exists
If Right(Path, 1) <> "\" Then Path = Path & "\"
If Dir(Path & File) = "" Then
GetValue = "File not Found"
Exit Function
End If
'Create the argument
Arg = "'" & Path & "[" & File & "]" & CStr(Sheet) & "'!" & Range(Ref).Range("A1").Address(, , xlR1C1)
'Check the value
MsgBox Arg
'Execute XML
GetValue = ExecuteExcel4Macro(Arg)
End Function
It has the advantage of not using complex adodb connection, but may be less powerfull.
I have some VBA code that looks like this and the aim is to query a csv file and bring back some records. However, I want to be able to query the same file (which sits on a network drive) at the same time from two computers. I tried using the readOnly mode but it still doesn't work. Please help?
Dim cnt_string As String
cnt_string = "Provider = Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=" & "V:\Data\;" & _
"Extended Properties = Text;"
strSQL = "SELECT * FROM " & strData & ".csv " & strData & " WHERE (" & strData & ".APPLICATION_ASSIGNED_TO='" & strBrokerNumber & "')"
Sheets("Broker").Activate
Dim rs As ADODB.Recordset
Set rs = New ADODB.Recordset
Call rs.Open(strSQL, cnt_string, CursorTypeEnum.adOpenForwardOnly, LockTypeEnum.adLockReadOnly, CommandTypeEnum.adCmdText)
Dim sh As Worksheet
Set sh = Sheets("Broker")
Call sh.Range("A10").CopyFromRecordset(rs)
rs.Close
Set rs = Nothing
It may be easier to just make a local temporary copy of the csv and import from that.
If that's not practical due to the size of the .csv, you could check to see if the file is locked by another user and sit in a loop until it becomes available.
It can't be done with a CSV.