|
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
|