new at vba. I have an Access database that updates an excel workbook. What I have so far it that is appends the set of records to the bottom of a data tab.
What I need to build is that before it appends the data I need for VBA to check the workbook for today's date in the Date column on the data tab. If it finds today's date, it shouldn't append the data.
I know i need to either max(date column) or DMax but I am lost on how to build this.
completely confused myself, so instead of getting more in the weeds I am asking for help.
Public Sub max_Click()
verintreportTemplate2 = "Template_VerintSchedulesResults_EST.xlsx"
reporttemplatelocation = "\Customer Service\Midwest\OH Group01\EntSchedAndForecast\BackUpDocs\NEW_DATABASE\Schedules_Process\Report_Templates\"
Drive = "z:"
Dim appExcel As Object
Set appExcel = CreateObject("Excel.Application")
With .Workbooks.Open(Drive & reporttemplatelocation & verintreportTemplate2)
.Worksheets ("DOW Summary Data")
'dateMax = DMax("Weekof")
so I stopped at this point.
If workbook structure is simple (single row column headers in first row), open a recordset using worksheet as data source. If worksheet has a complicated structure, specify a range or different approach will be needed.
Grab date value from record.
Public Sub max_Click()
Dim cn As ADODB.Connection
Dim rs As ADODB.Recordset
verintreportTemplate2 = "Template_VerintSchedulesResults_EST.xlsx"
reporttemplatelocation = "\Customer Service\Midwest\OH Group01\EntSchedAndForecast\BackUpDocs\NEW_DATABASE\Schedules_Process\Report_Templates\"
Drive = "z:"
Set cn = CreateObject("ADODB.Connection")
Set rs = CreateObject("ADODB.Recordset")
cn.Open "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & Drive & reporttemplatelocation & verintreportTemplate2 _
& ";Extended Properties=""Excel 12.0;HDR=Yes;IMEX=1"";"
rs.Open "SELECT Max(Weekof) AS MaxDate FROM [DOW Summary Data$]", cn, adOpenDynamic, adLockOptimistic
If Date() <> rs!MaxDate Then
'do something
End If
End Sub
Related
I am struggling to find relevant information on the
'run-time error '-2147418113 (8000ffff)' - Catastrophic Failure'
I am experiencing.
Sub GenerateAIA_Click()
Dim SQL_query, SQL_syntax, DB_path, setting_conn As String
Dim conn As New ADODB.Connection
Dim query_rslt As New ADODB.Recordset
Dim mth, mth_yr As Variant
Dim dt As Date
Dim i, bol As Integer
Dim temp1, temp2 As Variant
dt = Sheets("Main").Range("C4")
mth_yr = MonthName(Month(Sheets("Main").Range("I12")), False) & " " & Year(Sheets("Main").Range("I12"))
ThisWorkbook.Sheets("AIA").Select
DB_path = ThisWorkbook.FullName 'Refering the same workbook as Data Source
setting_conn = "Provider=MSDASQL.1;DSN=Excel Files;DBQ=" & DB_path & ";HDR=Yes';"
conn.Open setting_conn
SQL_syntax = "SELECT * FROM [Setup$]" 'Your SQL Statement (Table Name= Sheet Name=[Sheet1$])
query_rslt.Open SQL_syntax, conn
I have also noticed that this error is shown on the line
conn.Open setting_conn
I use excel 2016 and also my file format .xlsm
Anyone have idea why is this happening?
It seems your connection string has a problem.
Here's how I got it to work:
(First make sure to add a reference to the Microsoft Active-X Data Objects Library)
Sub test()
Dim conn As New ADODB.Connection
Dim rs As New ADODB.Recordset
conn.ConnectionString = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=c:\PC\test.xlsm;Extended Properties=""Excel 12.0 Macro;HDR=NO"";"
conn.Open
rs.Open "SELECT * FROM [Sheet1$]", conn
If Not rs.EOF Then
MsgBox rs(0) ' display the value of the first field in the first row
Else
MsgBox "No records found."
End If
rs.Close
conn.Close
End Sub
So take my example, change the filename to your XLSM file, and the sheet name to your sheet name (with a $ added to the end of it)
If your sheet has header names in the first now, use HDR=Yes, and if not, HDR=No
or you can change display resolution for your monitor
I'm a creating a vba macro for an Excel database. The database is about a number of people and the time spent by them on each of their projects. Whenever there's a new user, a new column adds up.
So, I tried with rs.Fields.Append but it's not working. :( can you help me?
Sub AjoutEnregistrement()
Dim cnn As ADODB.Connection
Dim rs As New ADODB.Recordset
Dim Project As String
Dim MyCheck As Boolean
Set cnn = New ADODB.Connection
Dim i As Variant
MyFile = "D:\Users\X\Documents\Checkin__2018.xlsm"
LoginID = "A01825112"
cnn.Open "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & _
Fichier & ";Extended Properties='Excel 12.0;HDR=No'"
Set rs = New ADODB.Recordset
rs.Open "SELECT * from [AUGUST$] ", cnn, adOpenDynamic, adLockOptimistic
rs.Fields.Append "LoginID"
rs.AddNew
rs.Update
rs.Close
cnn.Close
End Sub
Excel isn't a database, and you're not meant to interact with it this way. ADODB recordsets let you read/write recordsets to/from Excel, but they're not meant to be updated by VBA; as far as I know, what you're trying to do here isn't possible. It really sounds like Access would serve your needs far better than Excel would.
If you must use Excel, you should just do what you're trying to do directly. That is, add a column to a spreadsheet.
You can use the following sub to do so, given a worksheet and the header of the new column
Sub addHeader(ws As Worksheet, newColHeader As String)
Dim lastCol As Long
lastCol = ws.Cells(1, ws.columns.Count).End(xlToLeft).column
ws.Cells(1, lastCol + 1).Value = newColHeader
End Sub
In your example, you would call it with
addHeader Workbooks("Checkin__2018.xlsm").Worksheets("AUGUST$"), LoginID
You cannot add a column to an ADODB RecordSet after the RecordSet has been opened. Josh's answer is good - add the column in Excel and re-query.
My below code shows no error, when run, but I don't know how to extract required/particular field values into my excel sheet.
Sub getdatafromaccesstoanarray()
Dim cn As Object 'Connection
Dim rs As Object 'Recordset
Dim vAry() As Variant 'Variant Array
Dim dbPath As String 'Database Path
Dim dbName As String 'Database Name
Dim txt As String
Set cn = CreateObject("ADODB.Connection")
Set rs = CreateObject("ADODB.Recordset")
dbPath = ThisWorkbook.Path & "\"
dbName = "NewDB.accdb"
cn.Open "Provider=Microsoft.ACE.OLEDB.12.0;" & _
"Data Source=" & dbPath & dbName & ";"
rs.Open "SELECT * FROM BILLDETAILS WHERE BILLDETAILS.SN_AUTO =100;", cn
vAry = rs.GetRows()
'now when the data is copied to my array how can i paste specific values from this data to
'cells in my excel sheet
'like
'on active sheet
'[a1] = vAry(value1)
'[a2] = vAry(value3)
'[a3] = vAry(value8)
'and other values like wise
rs.Close
cn.Close
Set rs = Nothing
Set cn = Nothing
End Sub
If there any other way to do this then please let me know.
Thanks!
If you just want to copy the recordset into the sheet you can use the CopyFromRecordset method to dump the table into the sheet by specifying the top left corner:
Range("a1").copyfromrecordset rs
If you want to put specific fields in specific positions you can loop
Do While not rs.eof
range("a2")=rs(0)
range("b2")=rs(1)
'etc....
rs.movenext
Loop
I'm creating an excel workbook to manage my personal finances. My banks provide transaction data in CSV format and I found a way to import that data into excel using a QueryTable (using a "TEXT" connection.)
I'd like to automatically apply transaction category rules to each imported transaction. I have a worksheet with two columns - a string to match against the transaction "details" provided in my bank's CSV file and the category to apply to the matching transactions.
Is it possible to create an outer join between the CSV data and the categories worksheet and dump the resulting table into another worksheet?
For example (SQL pseudocodeish): SELECT csv.date, csv.details, csv.debit, csv.credit, ws.category FROM [csvfile] csv LEFT OUTER JOIN [worksheet] ws ON csv.details ~= ws.details
~= above would be some kind of string match. I can figure out the SQL, my question is really how to combine the CSV file and worksheet in the same QueryTable.
Excel will open CSV files without blinking, but you can use a connection string, if you prefer. It is even possible to write a query that compares an existing worksheet or named range with a text file using an Excel connection. All you need is a little VBA.
Set cn = CreateObject("ADODB.Connection")
Set rs = CreateObject("ADODB.Recordset")
'Note HDR=Yes, that is, first row contains field names '
'and FMT delimted, ie CSV '
strCon="Provider=Microsoft.Jet.OLEDB.4.0;Data Source=c:\Docs\;" _
& "Extended Properties=""text;HDR=Yes;FMT=Delimited"";"
cn.open strcon
'You would not need delimiters ('') if last field is numeric: '
strSQL="SELECT FieldName1, FieldName2 FROM The.csv " _
& " WHERE LastFieldName='SomeTextValue'"
rs.Open strSQL, cn
Worksheets("Sheet3").Cells(2, 1).CopyFromRecordset rs
You can use any suitable Jet SQL queries against the connection, just be careful about case sensitivity. For example, working with a connection to the current workbook:
Dim cn As Object
Dim rs As Object
Dim strFile As String
Dim strCon As String
Dim strSQL As String
Dim s As String
Dim i As Integer, j As Integer
''This is not the best way to refer to the workbook
''you want, but it is very convenient for notes
''It is probably best to use the name of the workbook.
strFile = ActiveWorkbook.FullName
''Note that if HDR=No, F1,F2 etc are used for column names,
''if HDR=Yes, the names in the first row of the range
''can be used.
''This is the Jet 4 connection string, you can get more
''here : http://www.connectionstrings.com/excel
strCon = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & strFile _
& ";Extended Properties=""Excel 8.0;HDR=Yes;IMEX=1"";"
''Late binding, so no reference is needed
Set cn = CreateObject("ADODB.Connection")
Set rs = CreateObject("ADODB.Recordset")
cn.Open strCon
strSQL = "SELECT * " _
& "FROM [Sheet1$] a " _
& "LEFT JOIN [Text;FMT=Delimited;HDR=Yes;" _
& "DATABASE=C:\Docs].Import.txt b " _
& "ON a.[Id]=b.[Id] "
rs.Open strSQL, cn, 3, 3
''Pick a suitable empty worksheet for the results
Worksheets("Sheet3").Cells(2, 1).CopyFromRecordset rs
''Tidy up
rs.Close
Set rs = Nothing
cn.Close
Set cn = Nothing
It is possible to create an OUTER JOIN referencing disparate data sources (csv, Excel, Access, txt, SQL, Oracle, etc) using ISAM Names in an ADO query. The results are held in a recordset that can be published back to Excel or another datasource as desired. Google "SQL ISAM Names" to find my other posts on the topic.
I am sure a little more info would help clear up my confusion but I don't believe it is possible to set up a SQL query against a CSV as Excel will not recognise it as a Data Source.
Have you thought about simply loading the csv into Excel and generating a pivot table/lookups on the data?
I am working on an Excel application that queries a SQL database. The queries can take a long time to run (20-40 min). If I've miss-coded something it can take a long time to error or reach a break point. I can save the results to a sheet fine, it's when I am working with the record sets that things can blow up.
Is there a way to load the data into a ADODB.Recordset when I'm debugging to skip querying the database (after the first time)?
Would I use something like this?
Query Excel worksheet in MS-Access VBA (using ADODB recordset)
I had to install the MDAC to get the msado15.dll and once I had it I added a reference to it from (on Win7 64bit):
C:\Program Files (x86)\Common Files\System\ado\msado15.dll
Then I created a function to return an ADODB.Recordset object by passing in a sheet name that exists in the currently active workbook. Here's the code for any others if they need it, including a Test() Sub to see if it works:
Public Function RecordSetFromSheet(sheetName As String)
Dim rst As New ADODB.Recordset
Dim cnx As New ADODB.Connection
Dim cmd As New ADODB.Command
'setup the connection
'[HDR=Yes] means the Field names are in the first row
With cnx
.Provider = "Microsoft.Jet.OLEDB.4.0"
.ConnectionString = "Data Source='" & ThisWorkbook.FullName & "'; " & "Extended Properties='Excel 8.0;HDR=Yes;IMEX=1'"
.Open
End With
'setup the command
Set cmd.ActiveConnection = cnx
cmd.CommandType = adCmdText
cmd.CommandText = "SELECT * FROM [" & sheetName & "$]"
rst.CursorLocation = adUseClient
rst.CursorType = adOpenDynamic
rst.LockType = adLockOptimistic
'open the connection
rst.Open cmd
'disconnect the recordset
Set rst.ActiveConnection = Nothing
'cleanup
If CBool(cmd.State And adStateOpen) = True Then
Set cmd = Nothing
End If
If CBool(cnx.State And adStateOpen) = True Then cnx.Close
Set cnx = Nothing
'"return" the recordset object
Set RecordSetFromSheet = rst
End Function
Public Sub Test()
Dim rstData As ADODB.Recordset
Set rstData = RecordSetFromSheet("Sheet1")
Sheets("Sheet2").Range("A1").CopyFromRecordset rstData
End Sub
The Sheet1 data:
Field1 Field2 Field3
Red A 1
Blue B 2
Green C 3
What should be copied to Sheet2:
Red A 1
Blue B 2
Green C 3
This is saving me a HUGE amount of time from querying against SQL every time I want to make a change and test it out...
--Robert
Easiest would be to use rs.Save "filename" and rs.Open "filename" to serialize client-side recordsets to files.
Another alternative to get a Recordset from a Range would be to create and XMLDocument from the target Range and open the Recordset from that document using the Range.Value() property.
' Creates XML document from the target range and then opens a recordset from the XML doc.
' #ref Microsoft ActiveX Data Objects 6.1 Library
' #ref Microsoft XML, v6.0
Public Function RecordsetFromRange(ByRef target As Range) As Recordset
' Create XML Document from the target range.
Dim doc As MSXML2.DOMDocument
Set doc = New MSXML2.DOMDocument
doc.LoadXML target.Value(xlRangeValueMSPersistXML)
' Open the recordset from the XML Doc.
Set RecordsetFromRange = New ADODB.Recordset
RecordsetFromRange.Open doc
End Function
Make sure to set a reference to both Microsoft ActiveX Data Objects 6.1 Library and Microsoft XML, v6.0 if you want to use the example above. You could also change this function to late binding if so desired.
Example call
' Sample of using `RecordsetFromRange`
' #author Robert Todar <robert#roberttodar.com>
Private Sub testRecordsetFromRange()
' Test call to get rs from Range.
Dim rs As Recordset
Set rs = RecordsetFromRange(Range("A1").CurrentRegion)
' Loop all rows in the recordset
rs.MoveFirst
Do While Not rs.EOF And Not rs.BOF
' Sample if the fields `Name` and `ID` existed in the rs.
' Debug.Print rs.Fields("Name"), rs.Fields("ID")
' Move to the next row in the recordset
rs.MoveNext
Loop
End Sub