Exporting A Selection of Records to Excel

Question

Hi All,
This is my first ever question to a forum, so please go easy on me! I'm also very new to Access and VBA. I'm building a database that stores (in related tables): TradingName, PropertyName, and PaddockName (as well as other relevant details). I have combined
(Joined) the data I require into a table as well as a query.
Now I want to export the Paddocks and Properties for each client. I have been able to export all clients and Paddocks (All Records) into Excel as well as individual Client and Paddock (Individual Record). But I want to be able to export all paddocks for
a property or a client (multiple records for a client or property).
My code is working for both scenarios (All Records and Individual Records) above but I'd like to know how to write code to export only selected Client or Property which is selected via a combobox.
The Code I have used seems to be typical on all forums I have visited, but none does what I want/need.
All help Appreciated
Thanks
Nath
This sub exports a SINGLE Record
'This Sub Exports ALL Records
Private Sub btnExportXls_Click()
Dim db As DAO.Database
Dim rs As DAO.Recordset
'Set db = DAO.DBEngine.Workspaces(0).OpenDatabase("C:\database.mdb")
Set db = CurrentDb
' Set rs = db.OpenRecordset("MasterSummary", dbOpenSnapshot)
Set rs = db.OpenRecordset("tblExpXlsClientPropPdkDetails", dbOpenSnapshot)
'Start a new workbook in Excel
Dim oApp As New Excel.Application
Dim oBook As Excel.Workbook
Dim oSheet As Excel.Worksheet
Set oBook = oApp.Workbooks.Add
Set oSheet = oBook.Worksheets(1)
'Add the field names in row 1
Dim i As Integer
Dim iNumCols As Integer
iNumCols = rs.Fields.Count
For i = 1 To iNumCols
oSheet.Cells(1, i).Value = rs.Fields(i - 1).Name
Next
'Add the data starting at cell A2
oSheet.Range("A2").CopyFromRecordset rs
'Format the header row as bold and autofit the columns
With oSheet.Range("a1").Resize(1, iNumCols)
.Font.Bold = True
.EntireColumn.AutoFit
End With
oApp.Visible = True
oApp.UserControl = True
'Close the Database and Recordset
rs.Close
db.Close
End Sub
This Sub Exports A Single Record (Paddock) and is commented out as I trialed the other sub.
'Private Sub btnExportXls_Click()
'' The following Sub only exported 1 record at a time and only copied data to selected cells, it doesn't move to next free cells.
''Export Selected Client/Property to Excel
''First you must set a Reference to the Microsoft Excel XX.X Object Library
' Dim appExcel As Excel.Application
' Dim wrkBook As Excel.Workbook
' Set appExcel = New Excel.Application
' Set wrkBook = appExcel.Workbooks.Open(CurrentProject.Path & "\ClientPropertyPdkDetails.xlsx")
' appExcel.Visible = True 'Make Excel Window Visible
''Make Batch Sheet the active Worksheet
' wrkBook.Worksheets("Client Property Pdk").Activate
' With wrkBook.ActiveSheet
' .Range("A2").Value = Me![Client_ID]
' .Range("B2").Value = Me![TradingName]
' .Range("C2").Value = Me![Property_ID]
' .Range("D2").Value = Me![Property]
' .Range("E2").Value = Me![ID]
' .Range("F2").Value = Me![PaddockName]
' .Range("G2").Value = Me![PaddockArea]
' .Range("H2").Value = Me![ArablePdkArea]
' .Range("I2").Value = Me![MonitoredPdk]
' .Range("J2").Value = Me![SoilSamplePdk]
' .Columns("A:J").AutoFit 'Autofit Columns A thru J to hold contents
' End With
''DoCmd.OutputTo acOutputQuery, "qryClientPropertyPaddockJoined", acFormatXLSX, "K:\Dropbox\1a Graminus Consulting\Graminus Database\ClientPropertyPdkDetails.xlsx", , , acExportQualityPrint
'End Sub

Answer 1

Hi All,
Thanks for your help and input much appreciated! I think I was in a rutt and trying to be too tricky (I think). I have since changed tact and created a Public Function (Below) that creates a temporary query and export that instead. It works a treat.
Thanks Again
Nath
Public Function CreateQueryDAO()
'Purpose: Create a query based on Clients Property Name to Export to Excel
Dim db As DAO.Database
Dim qdf As DAO.QueryDef
Set db = CurrentDb()
'The next line creates and automatically appends the QueryDef.
Set qdf = db.CreateQueryDef("qryPropertyDetails")
'Set the SQL property to a string representing a SQL statement.
qdf.sql = "SELECT tblExpXlsClientPropPdkDetails.* FROM tblExpXlsClientPropPdkDetails WHERE [Property_ID] =" & Forms![frmExportClientPropertyPaddockExl].txtPropertyID
'Do not append: QueryDef is automatically appended!
Debug.Print "qry[qryPropertyDetails] created."
'Start a new workbook in Excel
Dim oApp As New Excel.Application
Dim oBook As Excel.Workbook
Dim oSheet As Excel.Worksheet
Dim rs As DAO.Recordset
Set rs = db.OpenRecordset("qryPropertyDetails", dbOpenSnapshot)
Set oBook = oApp.Workbooks.Add
Set oSheet = oBook.Worksheets(1)
'Add the field names in row 1
Dim i As Integer
Dim iNumCols As Integer
iNumCols = rs.Fields.Count
For i = 1 To iNumCols
oSheet.Cells(1, i).Value = rs.Fields(i - 1).Name
Next
'Add the data starting at cell A2
oSheet.Range("A2").CopyFromRecordset rs
'Format the header row as bold and autofit the columns
With oSheet.Range("a1").Resize(1, iNumCols)
.Font.Bold = True
.EntireColumn.AutoFit
End With
oApp.Visible = True
oApp.UserControl = True
Debug.Print "Property Exported to Excel."
'Delete new Query.
db.QueryDefs.Delete "qryPropertyDetails"
Debug.Print "qry[qryPropertyDetails] Deleted."
'Close the Database and Recordset
rs.Close
db.Close
Set qdf = Nothing
Set db = Nothing
'Source: http://allenbrowne.com/func-dao.html#CreateQueryDAO
Private Sub btnCreateQry_Click()
CreateQueryDAO
End Sub