Export To Existing Excel File & Add Rows

[boborta]

My code needs to examine the record count based on a query, open an
existing Excel file, and add additional rows in the Excel file if the
record count > 4. If there are 1-4 records, the records can be pasted
directly. If the record count = 0, text is pasted into one cell
indicating there are no records. The code is below. What is not
working: Inserting blank rows (when record count >4), which prepares
the spreadsheet for records to be pasted.

Thanks for taking a look,
Bob

The code:

Private Sub PopulateWorkSheet()
'-------------------------------------------------------------
' Purpose: Exports data to excel file.
'
' Author :
'
' Phone:
'
' Notes :
' Tables:
' Calls:
'-------------------------------------------------------------
' Revision History
'-------------------------------------------------------------
'
'=============================================================
Dim dbe As DAO.DBEngine
Dim db As DAO.Database
Dim rst As DAO.Recordset
Dim NR As Integer
Dim intHowManyRows As Integer
Dim i As Integer
Dim j As Integer
Dim strQryName As String
Dim xlApp As New Excel.Application
Dim xlWb As Excel.Workbook
Dim xlWs As Excel.Worksheet
Dim xlRng As Excel.Range
Dim strFileName As String
Dim strWorkSheetName As String

On Error GoTo HandleErr

Set dbe = CreateObject("DAO.DBEngine.36")
Set db = CurrentDb()
strQryName = "Report 1a - All CITRUS Daily (New)"
strQryName = "t"
strFileName = "S:\_Medical Operations\ECM\001 Dev\db_home\CITRUS
\CITRUS_daily_TEMPLATE.xls"
xlApp.Visible = False
xlApp.Workbooks.Open FileName:=strFileName
Set xlWs = xlApp.ActiveSheet

Set rst = db.OpenRecordset(strQryName, dbOpenDynaset)
With rst
If .RecordCount > 0 Then
.MoveLast
.MoveFirst
NR = .RecordCount
With xlWs
If NR > 4 Then 'Insert blank rows = count of records
minus 4.
For j = 5 To NR
.Rows("5:5").Select
xlWs.Rows.Insert (xlDown)
'Selection.Insert Shift:=xlDown
Next
End If
Range("A4").Select
Range("A4").CopyFromRecordset rst
End With
Else
With xlWs
.Cells(5, 1).Value = "No Data to Report"
End With
End If
End With

rst.Close
xlApp.Visible = True
ExitHere:
Set db = Nothing
Set dbe = Nothing
Set rst = Nothing
Set xlApp = Nothing
xlApp.Quit
Exit Sub

HandleErr:
Select Case Err.Number
Case Else
MsgBox "Error " & Err.Number & ": " & Err.Description,
vbCritical, "Form_frmIIRI_Menu.Form_Open"

End Select

End Sub