starley_rover
New member
- Local time
- Today, 12:33
- Joined
- Dec 22, 2014
- Messages
- 8
Greetings, I only use MS-Access occasionally. I wrote some querydef/recordset to iterate reports for single institutions some years ago and tried to dust it off for a new project. I am trying to iterate writing totals to individual spreadsheets. I seem to have got the first section working (it will create, but not write to the first spreadsheet). The second subroutine shouldn't need alteration. It should adapt to the four parameters that it's fed. It fails at the line Dim xlApp As Excel.Application with the message
User defined type not defined. It then highlights in yellow:
Public Sub WriteRecordsetToExcelRange(strFilename As String, _
strSheetName As String, _
strFirstCell As String, _
daorst As DAO.Recordset)
I confess I am a bit baffled how to proceed.
Thanks for reading
Mark
User defined type not defined. It then highlights in yellow:
Public Sub WriteRecordsetToExcelRange(strFilename As String, _
strSheetName As String, _
strFirstCell As String, _
daorst As DAO.Recordset)
I confess I am a bit baffled how to proceed.
Thanks for reading
Mark
Code:
Public Sub HCVNewDiagnoses()
' mjm commenced 9 June 2020, based upon code composed for HPV Vaccination Pilot (2017-2018)
' Last update: 11 June 2020
' Uses DAO Recordsets to write query results to Excel Spreadsheets (report for each ODN)
' Process will allow for further data to be added subsequently to existing Excel outputs
Dim dbs As DAO.Database, rst As DAO.Recordset, rsTarget As DAO.Recordset
Dim strSQL, strSQLTarget, strFolder, strTargetFile As String
Set dbs = CurrentDb
strFolder = "C:\Users\xxx.yyy\HCVDashboard\outputs\"
' Select data elements from Lookup table
strSQL = "select ndxodn, txtodn FROM tlkpODN"
'Debug.Print strSQL
' Get the recordset to point to query
Set rst = dbs.OpenRecordset(strSQL)
rst.MoveFirst
'DoCmd.SetWarnings (WarningsOff)
'Do While rst!ndxodn = "NORTH EAST AND CUMBRIA" ' single ODN while debugging
Do While Not rst.EOF
'Debug.Print rst!ndxodn
strSQLTarget = "SELECT Count(tbl2019.FINALID) AS CountOfFINALID " & _
"FROM tbl2019 where tbl2019.odn1 = '" & rst!ndxodn & "' " & _
"GROUP BY odn1; "
'Debug.Print strSQLTarget
Set rsTarget = dbs.OpenRecordset(strSQLTarget)
strTargetFile = strFolder & Trim(rst!txtodn) & ".xlsx"
FileCopy strFolder & "Templatemjm.xlsx", strTargetFile
' Call subroutine to open Excel file and write range
' Four elements passed:
' 1) Target file name,
' 2) Worksheet to write to,
' 3) Start of range to write to,
' 4) source table or query (stored as a DAO recordset)
WriteRecordsetToExcelRange strTargetFile, "New diagnoses", "B7", rsTarget
rst.MoveNext
Loop
' Cleanup
'DoCmd.SetWarnings (WarningsOn)
rst.Close
rsTarget.Close
dbs.Close
Set rst = Nothing
Set rsTarget = Nothing
Set dbs = Nothing
End Sub
'This next subroutine belongs in a new code module, not one attached to a form or report.
'Four incoming elements passed:
'1) Target file name, 2) Worksheet to write to, 3) Start of range to write to, 4) source table or query (stored as a recordset)
Public Sub WriteRecordsetToExcelRange(strFilename As String, _
strSheetName As String, _
strFirstCell As String, _
daorst As DAO.Recordset)
'Declare variables
Dim xlApp As Excel.Application ' Instance of Excel
Dim xlSheet As Excel.Worksheet
Dim intRow As Integer, intCol As Integer 'Shifting coordinates of data
Dim intFirstRow As Integer, intFirstCol As Integer 'Start points of data, incremented by loops with above coordinates
' No records to process? Abort.
If daorst.RecordCount = 0 Then Exit Sub
'Open Excel File to modify
Set xlApp = CreateObject("Excel.Application")
xlApp.Visible = True ' make visible for debugging
xlApp.Workbooks.Open strFilename, False, False
'Define the Excel worksheet to export records to
Set xlSheet = xlApp.Worksheets(strSheetName)
intFirstCol = xlSheet.Range(strFirstCell).Column
intFirstRow = xlSheet.Range(strFirstCell).Row
daorst.MoveFirst
intRow = 0
'xlApp.DisplayAlerts = False 'IT WORKS TO DISABLE ALERT PROMPT
'Loop recordset and export each record to new row in Excel worksheet
' NB DAO (and Access) strict about numbering all built-in collections with ordinals beginning zero!
Do Until daorst.EOF
For intCol = 0 To rst.Fields.Count - 1
xlSheet.Cells(intFirstRow + intRow, intFirstCol + intCol) = daorst.Fields(intCol)
'intCol = intCol + 1
Next intCol
intRow = intRow + 1
daorst.MoveNext
Loop
' Cleanup
xlApp.ActiveWorkbook.Save
xlApp.ActiveWorkbook.Close
xlApp.Quit
'xlApp.DisplayAlerts = True 'RESETS DISPLAY ALERTS
Set xlSheet = Nothing
Set xlApp = Nothing
End Sub