Insert row excel after each record exported from access to excel

[accessvbanewbie]

I would like to export a recordset from access to excel but after each record is exported I want to insert a new row.
The first recordset does this ok. However, the second recordset onwards does not not export line excelsheet.Cells(9, 2) = rsschedulesrecords.Fields(2).Value.

Below is my code. Please help?

Private Sub CreateDailyRoster(rsschedulesrecords As DAO.Recordset)

Dim excelapp As New Excel.Application
Dim excelfile As New Excel.Workbook
Dim excelsheet As New Excel.Worksheet
Dim savefilepath As String
Dim tempi As Integer
Dim currdt As Date

currdt = txtStartDate.Value
tempi = 50 ''where remarks begin

Set excelfile = excelapp.Workbooks.Open(CurrentProject.Path & "\Template05.xls")
Set excelsheet = excelfile.Worksheets.Item(1)

excelsheet.Range("A1") = CDate(txtStartDate.Value)
excelsheet.Range("K4") = "" & Format(txtStartDate.Value, "dddd")
excelsheet.Range("P4") = "" & Format(txtStartDate.Value, "dd")
excelsheet.Range("T4") = "" & Format(txtStartDate.Value, "mmmm")
excelsheet.Range("AB4") = "" & Format(txtStartDate.Value, "yyyy")


If Not (rsschedulesrecords.EOF) Then
rsschedulesrecords.MoveFirst
excelsheet.Range("A8", "L8").Insert
'excelsheet.Range(tempr).Insert
tempi = tempi + 1
rsschedulesrecords.FindFirst (Format(currdt, "dddd") & "=Yes")
While Not (rsschedulesrecords.NoMatch)
excelsheet.Range("A8", "L8").Insert
tempi = tempi + 1
excelsheet.Cells(8, 2) = rsschedulesrecords.Fields(1).Value
excelsheet.Cells(9, 2) = rsschedulesrecords.Fields(2).Value
excelsheet.Cells(8, 4) = rsschedulesrecords.Fields(17).Value
excelsheet.Cells(8, 5) = rsschedulesrecords.Fields(20).Value
excelsheet.Cells(8, 7) = rsschedulesrecords.Fields(23).Value
excelsheet.Cells(8, 8) = rsschedulesrecords.Fields(27).Value
'excelsheet.Cells(8, 13) = ""
'excelsheet.Rows.Insert

If (Not IsNull(rsschedulesrecords.Fields(28).Value) And _
Len(Trim(rsschedulesrecords.Fields(28).Value)) > 0) Then
excelsheet.Range("A" & tempi, "L" & tempi).Insert
excelsheet.Cells(95, 1) = "Remarks/Airline Name " & rsschedulesrecords.Fields(1).Value & _
" " & rsschedulesrecords.Fields(2).Value & _
" " & rsschedulesrecords.Fields(15).Value & _
" : " & rsschedulesrecords.Fields(28).Value
tempi = tempi + 1
End If
'End With
rsschedulesrecords.FindNext (Format(currdt, "dddd") & "=Yes")
Wend
excelsheet.Range("A8", "L8").Insert
tempi = tempi + 1
excelsheet.Cells(3, 1) = Format(currdt, "dddd mmm dd")
currdt = DateTime.DateAdd("d", -1, currdt)
excelsheet.Cells(1, 4) = DateTime.Now
End If
savefilepath = "\OpsRoster_On-" & CStr(Format(txtStartDate.Value, "mmm-dd-yyyy")) & ".xls"

excelfile.SaveAs CurrentProject.Path & savefilepath
excelapp.ActiveWorkbook.Close True, CurrentProject.Path & savefilepath
excelapp.Quit

Set excelsheet = Nothing
Set excelfile = Nothing
Set excelapp = Nothing

End Sub

[Stewart Ross]

Hi. I think you mean 'record', not 'recordset' - a recordset is the complete set of records which you are traversing, not one of the records within it.

In terms of your code you are not using any form of record counter so for each record found you are just overwriting rows 8 and 9 over and over again.

As you are using two consecutive rows for each record you will need to increment your row counter by two on each pass. I show an indication of how to implement such a counter below.

Private Sub CreateDailyRoster(rsschedulesrecords As DAO.Recordset)
 
Dim excelapp As New Excel.Application
Dim excelfile As New Excel.Workbook
Dim excelsheet As New Excel.Worksheet
Dim savefilepath As String
Dim tempi As Integer
Dim currdt As Date
Dim rowcount as long
 
currdt = txtStartDate.Value
tempi = 50 ''where remarks begin
 
Set excelfile = excelapp.Workbooks.Open(CurrentProject.Path & "\Template05.xls")
Set excelsheet = excelfile.Worksheets.Item(1)
 
excelsheet.Range("A1") = CDate(txtStartDate.Value)
excelsheet.Range("K4") = "" & Format(txtStartDate.Value, "dddd")
excelsheet.Range("P4") = "" & Format(txtStartDate.Value, "dd")
excelsheet.Range("T4") = "" & Format(txtStartDate.Value, "mmmm")
excelsheet.Range("AB4") = "" & Format(txtStartDate.Value, "yyyy")
 
 
If Not (rsschedulesrecords.EOF) Then
rsschedulesrecords.MoveFirst
excelsheet.Range("A8", "L8").Insert
'excelsheet.Range(tempr).Insert
tempi = tempi + 1
rsschedulesrecords.FindFirst (Format(currdt, "dddd") & "=Yes")
While Not (rsschedulesrecords.NoMatch)
excelsheet.Range("A8", "L8").Insert
tempi = tempi + 1
excelsheet.Cells(8 + rowcount, 2) = rsschedulesrecords.Fields(1).Value
 excelsheet.Cells(9 + rowcount, 2) = rsschedulesrecords.Fields(2).Value
excelsheet.Cells(8+rowcount, 4) = rsschedulesrecords.Fields(17).Value
...
rsschedulesrecords.FindNext (Format(currdt, "dddd") & "=Yes")
rowcount = rowcount + 2
Wend
...
End Sub

-Stewart