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.Cell s(9, 2) = rsschedulesreco rds.Fields(2).V alue.
Below is my code. Please help?
Private Sub CreateDailyRost er(rsschedulesr ecords As DAO.Recordset)
Dim excelapp As New Excel.Applicati on
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.Va lue
tempi = 50 ''where remarks begin
Set excelfile = excelapp.Workbo oks.Open(Curren tProject.Path & "\Template05.xl s")
Set excelsheet = excelfile.Works heets.Item(1)
excelsheet.Rang e("A1") = CDate(txtStartD ate.Value)
excelsheet.Rang e("K4") = "" & Format(txtStart Date.Value, "dddd")
excelsheet.Rang e("P4") = "" & Format(txtStart Date.Value, "dd")
excelsheet.Rang e("T4") = "" & Format(txtStart Date.Value, "mmmm")
excelsheet.Rang e("AB4") = "" & Format(txtStart Date.Value, "yyyy")
If Not (rsschedulesrec ords.EOF) Then
rsschedulesreco rds.MoveFirst
excelsheet.Rang e("A8", "L8").Inser t
'excelsheet.Ran ge(tempr).Inser t
tempi = tempi + 1
rsschedulesreco rds.FindFirst (Format(currdt, "dddd") & "=Yes")
While Not (rsschedulesrec ords.NoMatch)
excelsheet.Rang e("A8", "L8").Inser t
tempi = tempi + 1
excelsheet.Cell s(8, 2) = rsschedulesreco rds.Fields(1).V alue
excelsheet.Cell s(9, 2) = rsschedulesreco rds.Fields(2).V alue
excelsheet.Cell s(8, 4) = rsschedulesreco rds.Fields(17). Value
excelsheet.Cell s(8, 5) = rsschedulesreco rds.Fields(20). Value
excelsheet.Cell s(8, 7) = rsschedulesreco rds.Fields(23). Value
excelsheet.Cell s(8, 8) = rsschedulesreco rds.Fields(27). Value
'excelsheet.Cel ls(8, 13) = ""
'excelsheet.Row s.Insert
If (Not IsNull(rsschedu lesrecords.Fiel ds(28).Value) And _
Len(Trim(rssche dulesrecords.Fi elds(28).Value) ) > 0) Then
excelsheet.Rang e("A" & tempi, "L" & tempi).Insert
excelsheet.Cell s(95, 1) = "Remarks/Airline Name " & rsschedulesreco rds.Fields(1).V alue & _
" " & rsschedulesreco rds.Fields(2).V alue & _
" " & rsschedulesreco rds.Fields(15). Value & _
" : " & rsschedulesreco rds.Fields(28). Value
tempi = tempi + 1
End If
'End With
rsschedulesreco rds.FindNext (Format(currdt, "dddd") & "=Yes")
Wend
excelsheet.Rang e("A8", "L8").Inser t
tempi = tempi + 1
excelsheet.Cell s(3, 1) = Format(currdt, "dddd mmm dd")
currdt = DateTime.DateAd d("d", -1, currdt)
excelsheet.Cell s(1, 4) = DateTime.Now
End If
savefilepath = "\OpsRoster _On-" & CStr(Format(txt StartDate.Value , "mmm-dd-yyyy")) & ".xls"
excelfile.SaveA s CurrentProject. Path & savefilepath
excelapp.Active Workbook.Close True, CurrentProject. Path & savefilepath
excelapp.Quit
Set excelsheet = Nothing
Set excelfile = Nothing
Set excelapp = Nothing
End Sub
The first recordset does this ok. However, the second recordset onwards does not not export line excelsheet.Cell s(9, 2) = rsschedulesreco rds.Fields(2).V alue.
Below is my code. Please help?
Private Sub CreateDailyRost er(rsschedulesr ecords As DAO.Recordset)
Dim excelapp As New Excel.Applicati on
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.Va lue
tempi = 50 ''where remarks begin
Set excelfile = excelapp.Workbo oks.Open(Curren tProject.Path & "\Template05.xl s")
Set excelsheet = excelfile.Works heets.Item(1)
excelsheet.Rang e("A1") = CDate(txtStartD ate.Value)
excelsheet.Rang e("K4") = "" & Format(txtStart Date.Value, "dddd")
excelsheet.Rang e("P4") = "" & Format(txtStart Date.Value, "dd")
excelsheet.Rang e("T4") = "" & Format(txtStart Date.Value, "mmmm")
excelsheet.Rang e("AB4") = "" & Format(txtStart Date.Value, "yyyy")
If Not (rsschedulesrec ords.EOF) Then
rsschedulesreco rds.MoveFirst
excelsheet.Rang e("A8", "L8").Inser t
'excelsheet.Ran ge(tempr).Inser t
tempi = tempi + 1
rsschedulesreco rds.FindFirst (Format(currdt, "dddd") & "=Yes")
While Not (rsschedulesrec ords.NoMatch)
excelsheet.Rang e("A8", "L8").Inser t
tempi = tempi + 1
excelsheet.Cell s(8, 2) = rsschedulesreco rds.Fields(1).V alue
excelsheet.Cell s(9, 2) = rsschedulesreco rds.Fields(2).V alue
excelsheet.Cell s(8, 4) = rsschedulesreco rds.Fields(17). Value
excelsheet.Cell s(8, 5) = rsschedulesreco rds.Fields(20). Value
excelsheet.Cell s(8, 7) = rsschedulesreco rds.Fields(23). Value
excelsheet.Cell s(8, 8) = rsschedulesreco rds.Fields(27). Value
'excelsheet.Cel ls(8, 13) = ""
'excelsheet.Row s.Insert
If (Not IsNull(rsschedu lesrecords.Fiel ds(28).Value) And _
Len(Trim(rssche dulesrecords.Fi elds(28).Value) ) > 0) Then
excelsheet.Rang e("A" & tempi, "L" & tempi).Insert
excelsheet.Cell s(95, 1) = "Remarks/Airline Name " & rsschedulesreco rds.Fields(1).V alue & _
" " & rsschedulesreco rds.Fields(2).V alue & _
" " & rsschedulesreco rds.Fields(15). Value & _
" : " & rsschedulesreco rds.Fields(28). Value
tempi = tempi + 1
End If
'End With
rsschedulesreco rds.FindNext (Format(currdt, "dddd") & "=Yes")
Wend
excelsheet.Rang e("A8", "L8").Inser t
tempi = tempi + 1
excelsheet.Cell s(3, 1) = Format(currdt, "dddd mmm dd")
currdt = DateTime.DateAd d("d", -1, currdt)
excelsheet.Cell s(1, 4) = DateTime.Now
End If
savefilepath = "\OpsRoster _On-" & CStr(Format(txt StartDate.Value , "mmm-dd-yyyy")) & ".xls"
excelfile.SaveA s CurrentProject. Path & savefilepath
excelapp.Active Workbook.Close True, CurrentProject. Path & savefilepath
excelapp.Quit
Set excelsheet = Nothing
Set excelfile = Nothing
Set excelapp = Nothing
End Sub
Comment