I've been searching for a direct solution, but haven't found anything quite like what I'm attempting to do on this board. I have an Excel worksheet that has several non-contiguous lists of bonds for different companies (think 5 bonds for one company, 3 fully empty rows, then another list of 6 bonds for another company, 5 fully empty rows, etc. etc.).
I'm trying to write an SQL update query that will directly update an Access table in .accdb format. I have fields that have the same name as the column headers in Excel, with the same data.
I need to perform this logic: where range A1 & B1 & C1 are not blank, add a new record to the table that shows A1 & B1 & C1 as fields [Ticker], [Coupon], [Maturity]. Where those cells ARE blank, move to the next row.
Can someone help evaluate my code? I'm getting an error 3343 at the point where I specify "Set db".
My preliminary code is below (scraped together from what I could find online as far as interfacing with Excel and SQL commands):
Sub UpdateDatabase()
Dim x As Integer
Dim strSQL As String
Dim db As Database
Dim dbLocation As String
Dim objConnection As Object
Worksheets("Bonds Clean").Activate
Range("A6").Select
dbLocation = "c:\Folders\Workflow Tables.accdb"
Set objConnection = CreateObject("DAO.DBEngine.36")
Set db = objConnection.OpenDatabase(dbLocation)
For x = 1 To Range(Selection, Selection.End(xlDown)).Rows.Count
If Not (Selection.Value = "") Then
strSQL = "UPDATE tblBonds_Temp SET"
strSQL = strSQL & "Ticker =" & Chr(34) & Selection.Offset(0, 1).Value & Chr(34) & ","
strSQL = strSQL & "Coupon =" & Chr(34) & Selection.Offset(0, 2).Value & Chr(34) & ","
strSQL = strSQL & "Maturity =" & Chr(34) & Selection.Offset(0, 3).Value & Chr(34) & ";"
db.Execute strSQL
Else
End If
Selection.Offset(1, 0).Select
Next
End Sub
DAO.DBEngine.36 is for DAO 3.6 which is suitable for MDB format database files. However, your database is ACCDB format which means that DAO 3.6 won't work. You must use the newer DAO instead.
'Set objConnection = CreateObject("DAO.DBEngine.36")
Set objConnection = CreateObject("DAO.DBEngine.120")
Related
I am attempting to read in an Excel File from a third party but it falls over and returns null due to empty column.
The file has 50 columns, a blank column and a further 48 columns. I only want the first 50 columns. If I delete or populate the empty column in Excel it works but I need to read 50+ files one after the other, regularly, so opening/deleting/saving isn't an option.
Function read_excel_file(StrPath, StrFile, ByRef TotalFileArray() As Variant)
Dim ReadFileArray() As Variant
Dim connectionString As String
connectionString = _
"Provider=Microsoft.ACE.OLEDB.12.0;" & _
"Data Source=""" & StrPath & StrFile & """;" & _
"Extended Properties=""Excel 12.0;HDR=Yes;"""
'This assumes the Excel file contains column headers -- HDR=Yes
'Routine to get unknown sheet name
Set conn = CreateObject("ADODB.Connection")
conn.connectionString = "Provider=Microsoft.ACE.OLEDB.12.0;" & _
"Data Source=""" & StrPath & StrFile & """;" & _
"Extended Properties=""Excel 12.0;HDR=No"""
conn.Open
Set bs = conn.OpenSchema(20) ' 20 = adSchemaTables
Do Until bs.EOF = True
'Debug.Print bs.Fields!Table_Name.Value
SheetName = bs.Fields!Table_Name.Value
bs.MoveNext
Loop
bs.Close: conn.Close
Set bs = Nothing
Set conn = Nothing
Dim sql As String
'sql = "SELECT Meter Id, Date, 00:30, 01:00, 01:30, 02:00, 02:30, 03:00, 03:30, 04:00, 04:30, 05:00, 05:30, 06:00, 06:30, 07:00, 07:30, 08:00, 08:30, 09:00, 09:30, 10:00, 10:30, 11:00, 11:30, 12:00, 12:30, 13:00, 13:30, 14:00, 14:30, 15:00, 15:30, 16:00, 16:30, 17:00, 17:30, 18:00, 18:30, 19:00, 19:30, 20:00, 20:30, 21:00, 21:30, 22:00, 22:30, 23:00, 23:30, 24:00:00 FROM [" + SheetName + "]" '
sql = "SELECT * FROM [" + SheetName + "]" '
'Dim rs As Object 'New adodb.Recordset
'Set rs = CreateObject("ADODB.Connection")
Dim rs As New ADODB.Recordset
rs.Open sql, connectionString
ReadFileArray() = rs.GetRows 'Puts the data from the recordset into an array
rs.Close
Set rs = Nothing
I did try using specific requests for the columns I wanted but this still returned null. I attempted a single column but again returned null.
Is there a way around the empty column? Even if reading the file in a different way. (I nearly always read in csv files which are a breeze to get into an array and deal with.)
Picture of source data headers
Given that you have no choice but to work with the files in the format provided, the best approach/workaround (rather than manually opening/deleting/saving/closing the files individually) would appear to be to pre-process them using VBA to delete the offending column, before then running your query.
If Excel worksheet contains columns in first row and you specify HDR=Yes, then your first SQL statement would work if you properly enclosed the column names with brackets since they contain special characters like spaces and start with numbers.
' OPEN CONNECTION WITH HEADERS INDICATED
connectionString = _
"Provider=Microsoft.ACE.OLEDB.12.0;" & _
"Data Source=""" & StrPath & StrFile & """;" & _
"Extended Properties=""Excel 12.0;HDR=Yes;"""
conn.Open connectionString
' RUN SQL WITH COLUMNS SPECIFIED
sql = "SELECT [Meter Id], [Date]" _
& " , [00:30], [01:00], ..., [23:30], [24:00:00]" _
& " FROM [" + SheetName + "]"
rs.Open sql, connectionString
...
In fact, your original attempt should have raised an error in attempting to run. Also, the second SQL with SELECT * FROM should raise an error with empty column since one of the column names is zero length which is an invalid identifier. Therefore, you need to explicitly select columns.
After deeper review, it appears your time columns may be in Custom format as time values which really are formatted Excel decimal values. Hence, the SQL engine cannot find [00:30] column. To fix, convert time value columns into text format.
Consider below subroutine to automate the conversion with Text(). You can then call this VBA sub or function from other main method on each worksheet before any SQL query. Do note there is no such time value as 24:00:00 so this may be already in text format.
Sub Clean_Time_Columns()
Dim i As Integer, lastcol As Integer
Dim tmp_time As Variant
With ThisWorkbook.Worksheets("DATA")
For i = 3 To 49 ' LEAVE OUT 24:00:00
tmp_time = .Cells(1, i).Value
.Cells(1, i).NumberFormat = "#"
.Cells(1, i).Value = Application.WorksheetFunction.Text(tmp_time, "HH:MM")
Next i
End With
End Sub
I have a fixed data set of 6 rows being queried in SQL. I want to transfer the data in this query into Excel. My question is in two parts:
1 - Can I pull back multiple columns in one go or do I have to do it column by column? I have 17 columns and 6 rows. As this is transferred into my Excel template I'm looking to break this up into thirds so columns 1 to 7 go in one space 8 to 11 in another section and 12 to 17 in another section in Excel.
2 - When using my current code of:
Range("F2").Value = rst.Fields("ACCOUNT")
I only pull back a single row, is it possible to get the whole column (all 6 rows) or do I have to loop all 6 rows to get the full column?
Thanks in advance
Use .GetRows() method, it allows to set a number of records to retrieve, first record to begin, and single field name or ordinal position, or an array of field names or ordinal position numbers.
The below example shows how to get data from external Excel workbook into recordset, retrieve specified fields into array, and paste result array to the worksheet.
Option Explicit
Sub Test()
Dim sConnection As String
Dim sQuery As String
Dim oConnection As Object
Dim oRecordset As Object
Dim aData()
sConnection = _
"Provider=Microsoft.ACE.OLEDB.12.0;" & _
"User ID=Admin;" & _
"Data Source='" & ThisWorkbook.FullName & "';" & _
"Mode=Read;" & _
"Extended Properties=""Excel 12.0 Macro;"";"
sQuery = _
"SELECT * FROM [Sheet1$] " & _
"IN '" & ThisWorkbook.Path & "\Src1.xlsx' " & _
"[Excel 12.0;Provider=Microsoft.ACE.OLEDB.12.0;Mode=Read;Extended Properties='HDR=YES;'] " & _
"WHERE Country='UK';"
Set oConnection = CreateObject("ADODB.Connection")
oConnection.Open sConnection
Set oRecordset = oConnection.Execute(sQuery)
oRecordset.MoveFirst
aData = oRecordset.GetRows(, , Array("CustomerID", "ContactName"))
With ThisWorkbook.Sheets(1)
.Cells.Delete
Output2DArray .Cells(1, 1), WorksheetFunction.Transpose(aData)
.Cells.EntireColumn.AutoFit
End With
oConnection.Close
End Sub
Sub Output2DArray(oDstRng As Range, aCells As Variant)
With oDstRng
.Parent.Select
With .Resize( _
UBound(aCells, 1) - LBound(aCells, 1) + 1, _
UBound(aCells, 2) - LBound(aCells, 2) + 1)
.NumberFormat = "#"
.Value = aCells
End With
End With
End Sub
Also there is Src1.xlsx workbook containing Customers as data source in the same folder as this workbook:
The resulting worksheet is as follows, you can see there are CustomerID and ContactName fields only:
I have an Excel file in which I have set up a connection with an Access database. In the Excel file I have a list of names in column A, and I want to search these names in the Access database and return back two fields from that database. I need to do this for around 200-300 names.
Here is my code:
N = Cells(Rows.Count, "A").End(xlUp).Row
Application.DisplayAlerts = False
strDB = ThisWorkbook.Path & "file.accdb"
Set objConnection = New ADODB.Connection
objConnection.Open "Provider=Microsoft.ACE.OLEDB.12.0; Data Source=" & strDB
For i = 2 To N
Dim rstTable As ADODB.Recordset
Set rstTable = New ADODB.Recordset
lookup = Range("A" & i).Value
strSQL = "SELECT NAME1,NAME2 FROM DATA WHERE [Field2]= """ & lookup & """;"
'Store query output
rstTable.Open Source:=strSQL, ActiveConnection:=objConnection
'Paste results to Transactions sheet
Worksheets("Sheet1").Range("B" & i).CopyFromRecordset rstTable
'Close the record set & connection
rstTable.Close
objConnection.Close
Next i
This works (kindof) but it takes an extremely long time and randomly crashes. Any ideas how to improve this?
Making sure there is a key on the lookup field will help. I would suggest making a copy of the workbook and test external data from Access or MS Query to see if that gives a performance gain over VBA.
When using MS Query or data from Access, you can modify the command text in the connection properties and use ? in the where clause to specify the parameter in the worksheet (so you don't lose that functionality).
I modified your SQL statement. Replace the Where [Field2] = "xxx" by Where [Field2] IN ("xxx", "yyy", "zzz").
N = Cells(Rows.Count, "A").End(xlUp).Row
Application.DisplayAlerts = False
strDB = ThisWorkbook.Path & "file.accdb"
Set objConnection = New ADODB.Connection
objConnection.Open "Provider=Microsoft.ACE.OLEDB.12.0; Data Source=" & strDB
For i = 2 To N
lookup = lookup & "'" & Range("A" & i).Value & "', "
Next i
lookup = left(lookup, len(lookup) - 2)
Dim rstTable As ADODB.Recordset
Set rstTable = New ADODB.Recordset
strSQL = "SELECT NAME1,NAME2 FROM DATA WHERE [Field2] IN (" & lookup & ");"
'Store query output
rstTable.Open Source:=strSQL, ActiveConnection:=objConnection
'Paste results to Transactions sheet
Worksheets("Sheet1").Range("B" & i).CopyFromRecordset rstTable
'Close the record set & connection
rstTable.Close
objConnection.Close
You close the connection after the first iteration, so your next iteration -- which does not have code to open the connection -- would fail. So you should move the objConnection.Close out of the loop.
But, even then, to execute the same kind of query over and over again, just with a different argument, can be done in one go, using the IN (...) syntax:
' Declare all your variables
Dim N As Long
Dim strDB As String
Dim objConnection As ADODB.Connection
Dim rstTable As ADODB.Recordset
Dim strSQL As String
N = Cells(Rows.Count, "A").End(xlUp).Row
Application.DisplayAlerts = False
strDB = ThisWorkbook.Path & "file.accdb"
Set objConnection = New ADODB.Connection
objConnection.Open "Provider=Microsoft.ACE.OLEDB.12.0; Data Source=" & strDB
' collect the values in comma-separated string
lookup = ""
For i = 2 To N
lookup = lookup & ",""" & Range("A" & i).Value & """"
Next i
' Chop off the first comma
lookup = Mid(lookup, 2)
' Perform a single query, but also select the Field2 value
Set rstTable = New ADODB.Recordset
strSQL = "SELECT Field2, NAME1,NAME2 FROM DATA WHERE [Field2] IN (" & lookup & ");"
' query output
rstTable.Open Source:=strSQL, ActiveConnection:=objConnection
' Retrieve values
While Not rstTable.EOF
lookup = rstTable.Fields(0).Value
' Locate in which row to put the result
For i = 2 To N
If lookup = Range("A" & i).Value Then
Range("B" & i).Value = rstTable.Fields(1).Value
Range("C" & i).Value = rstTable.Fields(2).Value
End If
Next i
rstTable.MoveNext
Loop
' Close the record set & connection
rstTable.Close
objConnection.Close
You can do what you described, but I think it's far more efficient to do this in Access itself. Just create a table with your names and do an Inner Join to the table you want to find 2 fields. Should take less than a minute, and probably less than 30 seconds.
I am pulling another workbook containing a table that has Columns like ItemCreationDate, and most columns (total 28 such columns) that begin with the word "Global" in them. i want to
pull these "Global" columns (including ItemCreationDate) into an SQL recordset,
add a new Column called Old/New and then
UNPIVOT them i.e. Stack them up one above the other and
in the next column, list their Column items along with their Counts.
Their Counts are derived based on the ItemCreationDate where any date <2015 is OLD & >=2015 is NEW
Final Output should be as shown in Output sheet.
i have attached a Sample.xlsx file where i have shown how i have to arrive at the Output tab starting from the Data sheet. This Data sheet is actually the input that i want to pull into a recordset and spit out the table as shown in the Output sheet. I don't want to create Pivot table as its cumbersome and the data is quite a lot, and i want an alternative SQL approach, wherein i can quickly aggregate the data and insert it into sheet in one go.
i am not using SQL Server, so cannot use the UNPIVOT command or Dynamic SQL to loop thru all the "Global" columns.
Basically i want to form a correct SQL string something like....
Dim arrSQL as variant
......
......
RS.Filter="Like Global*"
......
arrSQL = JOIN(RS.Fields, vbCr)
strSQL = "SELECT [arrSQL], IIF(YEAR([ITEM CREATION DATE])>=YEAR(DATE())-1,""NEW"",""OLD"") AS [New/Old] from [Data$] GROUP BY...."
strSQL = strSQL & " UNION ALL " & vbcr & _
strSQL = strSQL & " ......
Now, run SQL on same recordset to reduce the columns and get required data format....
i know the above is not quite correct, but something on those lines so that i can get the correct output as show in the Output tab.
can anyone help quickly?
Edits for #a_horse_with_no_name :
see the screenshots of the sample file:
Data sheet:
this is actually a table from an input workbook that i want to pull in a Recordset. See the various "Global" column headings and their items that i want to unpivot.
This are the 2 intermediate sheets "New" & "Old" i have to create everytime (that i want to get rid of actually). any items found in 2015 or later are put in New, whereas rest are put in Old.
JFYI, the formulae that are manually used in Output columns are :
C column (New):
=COUNTIF(INDEX(New!$A:$D,0,MATCH($A2,New!$1:$1,0)),Output!$B2)
D Column (Old):
=COUNTIF(INDEX(Old!$A:$D,0,MATCH($A2,Old!$1:$1,0)),Output!$B2)
E Column (% New):
=Output!C2/SUM(C$2:C$6)
F Column (% Old):
=Output!D2/SUM(D$2:D$6)
G Column (Index):
=IF(AND(E2<=0,F2<=0),0,IF(AND(E2>0,F2>0),E2/F2,1))
Hope this helps.
Indeed, you can run SQL queries in MS Excel using the Jet/ACE SQL Engine (a Windows .dll file) which is the very data store that MS Access is connected to by default. And as such, this technology equipped on all PCs is not restricted to any one Office/Windows program.
Consider the following Excel VBA macro (if using Excel on PC) that connects to ACE via ADO running a union of three aggregate SQL queries (GLOBAL VIT/CALC, GLOBAL FLAVOURS, GLOBAL FLAVOUR GROUP) and conditional New and Old counts/percentages. The latter percentage column pair required subqueries.
For proper setup, do the following:
Make sure Item Creation Date is in MM-DD-YYYY (US-based) or DD-MM-YYYY (non-US based) date formats which is not how above screenshot or file has date field currently formatted.
Sub FormatDates()
For i = 2 To 2083
Range("A" & i) = CDate(Range("A" & i))
Next i
End Sub
Run macro in a different workbook than the one holding the data. Below assumes data workbook holds source information in worksheet named Data.
In query-running workbook, create a blank worksheet named RESULTS which will be populated with query output including column headers.
VBA Script (two connections available Driver (commented out) and Provider versions)
Option Explicit
Sub RunSQL()
Dim cols As Object, datawbk As Workbook, datawks As Worksheet
Dim lastcol As Integer, i As Integer, j As Variant, output As Variant
Set cols = CreateObject("Scripting.Dictionary")
Set datawbk = Workbooks.Open("C:\Path\To\Data\Workbook.xlsx;")
Set datawks = datawbk.Worksheets("Data")
lastcol = datawks.Cells(7, datawks.Columns.Count).End(xlToLeft).Column
For i = 2 To lastcol
cols.Add CStr(i - 1), datawks.Cells(1, i).Value
Next i
datawbk.Close False
Set datawks = Nothing
Set datawbk = Nothing
output = DataCapture(cols)
End Sub
Function DataCapture(datacols As Object)
On Error GoTo ErrHandle
Dim conn As Object, rst As Object
Dim strConnection As String
Dim classSQL As String, itemSQL As String, grpSQL As String, strSQL As String
Dim i As Integer, fld As Object, d As Variant, lastrow As Integer
Set conn = CreateObject("ADODB.Connection")
Set rst = CreateObject("ADODB.Recordset")
' Hard code database location and name '
' strConnection = "DRIVER={Microsoft Excel Driver (*.xls, *.xlsx, *.xlsm, *.xlsb)};" _
' & "DBQ=C:\Path\To\Data\Workbook.xlsx;"
strConnection = "Provider=Microsoft.ACE.OLEDB.12.0;" _
& "Data Source='C:\Path\To\Data\Workbook.xlsx;" _
& "Extended Properties=""Excel 12.0 XML;HDR=YES IMEX=1;"";"
' OPEN DB CONNECTION '
conn.Open strConnection
For Each d In datacols.keys
strSQL = " SELECT '" & datacols(d) & "' AS [COLUMN], [Data$].[" & datacols(d) & "] AS ITEMS," _
& " SUM(IIF(Year([Item Creation Date]) >= Year(Date()) - 1, 1, 0)) AS NEW," _
& " " _
& " SUM(IIF(Year([Item Creation Date]) < Year(Date()) - 1, 1, 0)) AS OLD," _
& " " _
& " ROUND(SUM(IIF(Year([Item Creation Date]) >= Year(Date()) - 1, 1, 0)) / " _
& " (SELECT Count(*) FROM [Data$] AS sub" _
& " WHERE Year(sub.[Item Creation Date]) >= Year(Date()) - 1),2) AS NEWPCT," _
& " " _
& " ROUND(SUM(IIF(Year([Item Creation Date]) < Year(Date()) - 1, 1, 0)) / " _
& " (SELECT Count(*) FROM [Data$] AS sub" _
& " WHERE Year(sub.[Item Creation Date]) < Year(Date()) - 1),2) AS OLDPCT" _
& " FROM [Data$]" _
& " GROUP BY [Data$].[" & datacols(d) & "]"
' OPEN RECORDSET '
rst.Open strSQL, conn
' COLUMN HEADERS '
If d = 1 Then
i = 0
Worksheets("RESULTS").Range("A1").Activate
For Each fld In rst.Fields
ActiveCell.Offset(0, i) = fld.Name
i = i + 1
Next fld
End If
' DATA ROWS '
lastrow = Worksheets("RESULTS").Cells(Worksheets("RESULTS").Rows.Count, "A").End(xlUp).Row
Worksheets("RESULTS").Range("A" & lastrow + 1).CopyFromRecordset rst
rst.Close
Next d
conn.Close
MsgBox "Successfully processed SQL query!", vbInformation
Exit Function
ErrHandle:
MsgBox Err.Number & " - " & Err.Description, vbCritical
Exit Function
End Function
Output
I extract data from my Access database into an Excel worksheet using a macro. I first open a connection to the database, define my sql statement in a string var and then dump that data in a recordset:
Dim db As Database
Dim rs As RecordSet
Dim sql As String
Dim dbLocation As String
dbLocation = ThisWorkbook.Path & "\database\data.accdb"
Set db = OpenDatabase(dbLocation)
sql = "Select * FROM [Master Table]"
Set rs = db.OpenRecordSet(sql, dbOpenSnapshot)
If Not rs.EOF Then
Worksheets("Sheet1").Range("A1").CopyFromRecordset rs
End If
rs.Close
Set rs = Nothing
db.Close
Set db = Nothing
This works perfectly. I distribute this to some people and ask them to update fields. I then need to update the Access data with data that is passed back. The simple thing in terms of design is that the extracted excel data mirrors the access db in structure so the update query should be simple. Also there is a primary key, so I would just need to map on that field.
Any ideas how this can be done? Can I load the whole excel datasheet into a recordset and run some snazzy update query?
You need to loop over rows on sheet 1, and for each row make sql string that looks like:
"update [Master table] set
TableField1 = " & Range(Row, Col1).Value & ","
TableField2 = " & Range(Row, Col2).Value & ","
...
where IDTableField = " & Range(Row, IDColNum).Value
and then do
db.Execute thatString
PS: There are may be mistakes in my syntax. And you need to convert cell values to strings when making string.
An extension of shibormot's solution using DAO:
Set objConnection = CreateObject("DAO.DBEngine.36")
Set db = objConnection.OpenDatabase(strDBPath, blnExclusive, blnReadOnly, strPassword)
For Each row In Range("A1:C3").Cells
strSQL = "UPDATE table SET "
strSQL = strSQL & "Field1 = " & Chr(34) & row.Cells(1) & Chr(34) & ","
strSQL = strSQL & "Field2 = " & Chr(34) & row.Cells(2) & Chr(34) & ","
strSQL = strSQL & "Field3 = " & Chr(34) & row.Cells(3) & Chr(34)
Db.Execute
Next
Threw in the chr(34) for string data