I am trying to automate a data pull from Access into Excel using ADO. Each week I pull in the previous weeks deals from Monday-Friday. Right now I have SQL pulling in the deals from the previous week, however the way I have it right now I would manually have to change the dates in the code each week. Is there a way to do this automatically?
Below is the code I currently have:
Sub Import()
'Declaring the necessary variables
Dim cn As ADODB.Connection
Dim rs As ADODB.Recordset
Dim dbPath As String
Dim SQL As String
Dim i As Integer
Dim var As Range
cn.Open "Provider=Microsoft.ACE.OLEDB.12.0;" & _
"Data Source=xxx"
'create the SQL statement to retrieve the data from the table
sSQL = "SELECT * FROM BP_Closed_Deals WHERE Start_Date between '10/21/2019' and '10/25/2019'"
'create the ADODB recordset object
Set rs = New ADODB.Recordset
'connectionString open
rs.Open sSQL, cn, adOpenForwardOnly, adLockReadOnly, adCmdText
If Not rsData.EOF Then
Sheets("Deals_2018_Copy").Range("A2").CopyFromRecordset rsData
rsData.Close
Else
rsData.Close
MsgBox "Error: No records returned", vbCritical
End If
Set rsData = Nothing
End Sub
Consider finding last Monday and Friday's date relative to today using DatePart:
sSQL = "SELECT * FROM BP_Closed_Deals "_
& "WHERE Start_Date BETWEEN Date() - (DatePart('d', Date()) - 2) - 7" _
& " AND Date() - (DatePart('d', Date()) - 2) - 3"
Related
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
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 trying to pull data from SQL via an ADODB recordset in VBA. I'm struggling to get results from each part of a SQL query when it contains semi-colons. Wondering if there's any way to do this without splitting my query into separate queries (to remove the semi-colon issue) and using separate recordsets for each.
See below for a simple example. When I run it, F2=1, G2=Failed - I want F2=1, G2=2.
' Sub to test using semi-colons in SQL queries
Sub getDataSimple0(server As String, database As String)
' Initialise variables
Dim con As ADODB.Connection
Dim rs As ADODB.Recordset
Set con = New ADODB.Connection
Set rs = New ADODB.Recordset
' Open Connection using Windows Authentication
con.ConnectionString = "Provider=SQLOLEDB;Data Source=" & server & ";Initial Catalog=" & database & ";Trusted_connection=Yes;Integrated Security=SSPI;Persist Security Info=True;"
con.Open
' Open recordset
rs.Open "SELECT 1; SELECT 2", con
' Add data to worksheet
Range("F2").CopyFromRecordset rs
rs.NextRecordset
If rs.State > adStateClosed Then
Range("G2").CopyFromRecordset rs
Else
Range("G2").Value = "Failed"
End If
' Close connection
con.Close
End Sub
I would go about it by doing something like the below.
' Sub to test using semi-colons in SQL queries
Sub getDataSimple0(server As String, database As String)
' Initialise variables
Dim con As ADODB.Connection
Dim rs As ADODB.Recordset
Dim SQL_String As String
Dim SQL_Array() As String
Dim i As Integer
Set con = New ADODB.Connection
Set rs = New ADODB.Recordset
' Open Connection using Windows Authentication
con.ConnectionString = "Provider=SQLOLEDB;Data Source=" & server & ";Initial Catalog=" & database & ";Trusted_connection=Yes;Integrated Security=SSPI;Persist Security Info=True;"
con.Open
'Multiple queries
SQL_String = "SELECT 1; SELECT 2"
'Split into array
SQL_Array = Split(SQL_String, ";")
'Add data to worksheet
For i = LBound(SQL_Array) To UBound(SQL_Array)
rs.Open SQL_Array(i), con
Range("F2").Offset(0, i).CopyFromRecordset rs
Next i
' Close connection
con.Close
End Sub
Here I take the multiple queries and split them into an array that I loop over. Assuming that you want the ouptut in columns from column F and onward.
I believe you need to set the rs to the result of NextRecordset, so the code looks like this:
' Sub to test using semi-colons in SQL queries
Sub getDataSimple0(server As String, database As String)
' Initialise variables
Dim con As ADODB.Connection
Dim rs As ADODB.Recordset
Set con = New ADODB.Connection
Set rs = New ADODB.Recordset
' Open Connection using Windows Authentication
con.ConnectionString = "Provider=SQLOLEDB;Data Source=" & server & ";Initial Catalog=" & database & ";Trusted_connection=Yes;Integrated Security=SSPI;Persist Security Info=True;"
con.Open
' Open recordset
rs.Open "SELECT 1; SELECT 2", con
' Add data to worksheet
Range("F2").CopyFromRecordset rs
Set rs = rs.NextRecordset
If rs.State > adStateClosed Then
Range("G2").CopyFromRecordset rs
Else
Range("G2").Value = "Failed"
End If
' Close connection
con.Close
End Sub
I want to be able to JOIN Excel tables to MsSQL tables, or to other Excel tables. I am trying to test the second case. I'm trying to get data from Excel table using the OPENROWSET. Later I will use this to join tables, but now I cant get working even this simple query.
Ciselnik1 is a Worksheet in Test.xlsx Workbook and contains a small table with header:
FK__S_HEAD | Desc
-------------------------------
ODD AM | ODD - description1
ODDZP | ODD - desc2
The follwing code is throwing the "syntax error in FROM clause" error:
Sub TestExternalSQLwithCisJoin()
Dim objConn As ADODB.Connection, objCmd As ADODB.Command, objRS As ADODB.Recordset
Dim sPath As String, sSQL As String, sConn As String
Set objConn = New ADODB.Connection
Set objCmd = New ADODB.Command
Set objRS = New ADODB.Recordset
sSQL = "SELECT * FROM OPENROWSET(""Microsoft.ACE.OLEDB.12.0"",""Database=c:\...\Test.xlsx;Extended Properties=Excel 12.0 Xml;HDR=YES"",""SELECT * FROM [Ciselnik1$]"")"
sConn = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=c:\...\Test.xlsm;Extended Properties=""Excel 12.0 Macro;HDR=YES"";"
Set objConn = New ADODB.Connection
'MsgBox sSQL
objConn.Open sConn
'objRS.Open sSQL, objConn, adOpenStatic, adLockBatchOptimistic, adCmdText
objConn.Execute sSQL, lngRecsAff, adExecuteNoRecords
Dim A0cell As Range
Worksheets("Test").Activate
Set A0cell = Worksheets("Test").Cells(1, 1)
A0cell.CopyFromRecordset objRS
End Sub
OPENROWSET is just not a function the Microsoft.ACE.OLEDB.12.0 provider supports.
i want to allow the user to upload xls file with 9 columns and unlimited number of rows.
i will run over everyline and insert the data to the db
how do i read the xls file?
You can read the XLS by opening an ADO recordset which pulls in the spreadsheet's data.
This example reads data from a spreadsheet named Billing Summary which includes column names in the first row..
Public Sub ReadSpreadsheet()
Const cstrFolder As String = "C:\Access\webforums"
Const cstrFile As String = "ExampleFinance.xls"
Dim strConnect As String
Dim strSql As String
Dim cn As Object
Dim rs As Object
Set cn = CreateObject("ADODB.Connection")
Set rs = CreateObject("ADODB.Recordset")
strConnect = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & _
cstrFolder & Chr(92) & cstrFile & _
";Extended Properties=""Excel 8.0;HDR=Yes;IMEX=1"";"
cn.Open strConnect
strSql = "SELECT * FROM [Billing Summary$] WHERE SomeField Is Not Null;"
rs.Open strSql, cn
Do While Not rs.EOF
'* do something with each row of data *'
'Debug.Print rs!SomeField '
rs.MoveNext
Loop
rs.Close
Set rs = Nothing
cn.Close
Set cn = Nothing
End Sub
If that particular connection string doesn't work for you, look at other examples of Excel connection strings at Connection strings for Excel
Edit: That example works in Access. But you said ASP. I think it will work there, too, if you drop the data types from the variable and constant declarations: Dim strSql instead of Dim strSql As String
Example of using an SQL statement to update Access from Excel.
Set cn = CreateObject("ADODB.Connection")
scn = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=c:\docs\dbto.mdb"
cn.Open scn
sSQL = "SELECT * INTO NewTable FROM "
sSQL = sSQL & "[Excel 8.0;HDR=YES;IMEX=2;DATABASE=C:\Docs\From.xls].[Sheet1$]"
cn.Execute sSQL, recs
MsgBox recs
In C#, I had to load an excel spreadsheet to a DataSet - this got me there...
Code Project Example
I used Option 1 - the Preferred method! Hope this helps...
Mike