Excel instance (Recordset/QueryDef) (1 Viewer)

starley_rover

New member
Local time
Today, 21:50
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

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
 

Uncle Gizmo

Nifty Access Guy
Staff member
Local time
Today, 21:50
Joined
Jul 9, 2003
Messages
13,433
I'm not quite getting the gist of your question, I get the impression you want to write information into multiple sheets within an Excel workbook. If thats the case, then I'm wondering if something I did recently might be along the lines you're looking for.

There's a video here which demonstrates what I mean:-

Make Hundreds of Excel Sheets From MS Access Table - Nifty Access


More information and the Code available on my website here:-

Export 45000 Rows to 286 Sheets
 

Micron

AWF VIP
Local time
Today, 16:50
Joined
Oct 20, 2018
Messages
3,472
Check for broken or missing references (vb editor > Tools > References) as a start.
Note that when you declare multiple variables on one line like this

Dim strSQL, strSQLTarget, strFolder, strTargetFile As String

only the last is a string; the rest are variants. Not that it is the cause of this issue, but may cause other issues. Also, you will raise and error if your recordset has no records and you attempt to move.
 

Gasman

Enthusiastic Amateur
Local time
Today, 21:50
Joined
Sep 21, 2011
Messages
9,083
Sounds like you need a reference set?

Might be OLE Automation ?
 

Minty

AWF VIP
Local time
Today, 21:50
Joined
Jul 26, 2013
Messages
8,831
Dim xlApp As Excel.Application with the message
User defined type not defined. It then highlights in yellow:
This generally means you are missing a reference - either switch to using late binding or add the appropriate references
 

starley_rover

New member
Local time
Today, 21:50
Joined
Dec 22, 2014
Messages
8
Dear all
Thank you so much for pointing me in the right direction. I looked at the references from the original database, and replicated them. I also changed the Dim statement as advised. Worked first time.
refs.PNG
 

Users who are viewing this thread

Top Bottom