Insert row excel after each record exported from access to excel

Collapse
X
 
  • Time
  • Show
Clear All
new posts
  • accessvbanewbie
    New Member
    • Mar 2008
    • 6

    Insert row excel after each record exported from access to excel

    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
  • Stewart Ross
    Recognized Expert Moderator Specialist
    • Feb 2008
    • 2545

    #2
    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.

    Code:
    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
    [b]excelsheet.Cells(9 + rowcount, 2) = rsschedulesrecords.Fields(2).Value[/b]
    excelsheet.Cells(8+rowcount, 4) = rsschedulesrecords.Fields(17).Value
    ...
    rsschedulesrecords.FindNext (Format(currdt, "dddd") & "=Yes")
    rowcount = rowcount + 2
    Wend
    ...
    End Sub
    -Stewart

    Comment

    Working...