Excel export is over writing spreadsheet

[irethedo]

I am trying to reuse some previous code but it seems like I am missing something...

The following code dumps the contents of table CleanPC_tbl into a spreadsheet and
I would like this to be an append but the spreadsheet keeps getting over written.
What am I missing?

Thanks

Set objXL = CreateObject("Excel.Application")
    Set db = CurrentDb
    Set rs1 = db.OpenRecordset("CleanPC_tbl", dbOpenSnapshot)
    If rs1.RecordCount > 0 Then      ' if this is an empty table then don't bother...
       Set objXL = CreateObject("Excel.Application")
       Set db = CurrentDb
      
       With objXL
         .Visible = True
          Set fso = CreateObject("Scripting.FileSystemObject")
        
           objXL.DisplayAlerts = False  'Remove prompt to save file
           If (fso.FileExists(Out_File)) Then
             Set objWkb = .Workbooks.Open(Out_File)
 '          End If
        Else
           objXL.DisplayAlerts = False  'Remove prompt to save file
           Set objWkb = .Workbooks.Add
             With objWkb
             .Worksheets(1).Name = "PCs on Order"
             .SaveAs Out_File, 51
             End With
'             tempName = rs1!Date
             objXL.DisplayAlerts = True     'Open after report is completes
         End If
       
       On Error Resume Next
         Set objSht = objWkb.Worksheets("PCs on Order")         'RSP
'         If tempSIMmode = True Then        ' If this is set to simulation mode set then add a title to the start of the spreadsheet
'            For Each fld In rs1.Fields
'               objSht.Cells(1, iCol + 1).Value = fld.Name
'               iCol = iCol + 1
'            Next
'         End If
         objWkb.Worksheets("RSP").Activate
         lngLastRow = objSht.Cells.Find(What:="*", _
           After:=objSht.Range("A1"), _
           LookAt:=2, _
           LookIn:=-4123, _
           SearchOrder:=1, _
           SearchDirection:=2, _
           MatchCase:=False).Row
        End With
        lngLastRow = lngLastRow + 1
        With objSht
         .Range("A" & lngLastRow).CopyFromRecordset rs1
          With .Rows(lngLastRow & ":" & lngLastRow + rs1.RecordCount)
           .Font.Bold = False
'          .HorizontalAlignment = -4108
           .Font.Color = vbBlack
           .Font.Name = "Calibri"
           .Font.Size = 11
          End With
'            With .Columns("A:A").NumberFormat = "mmmm dd, yyyy"
'            End With
        End With
        strSql = "Sales Order " & tempOrder & "has been added to the spreadsheet"
        reply = MsgBox(strSql, vbOKOnly, "Process Complete")
    End If
    Set rs1 = Nothing
    Set objSht = Nothing
    
   DoCmd.SetWarnings True     ' allow all update table qry messages
   objWkb.Save
   objWkb.Close
   objXL.Quit
   
   Set objXL = Nothing
   Set rs1 = Nothing

 

[Andrzejek]

When you step thru your code, and you already have some data in your worksheet that you want to keep...

What is the value of [tt]lngLastRow [/tt] at the end of this piece of code:

lngLastRow = objSht.Cells.Find(What:="*", _
  After:=objSht.Range("A1"), _
  LookAt:=2, _
  LookIn:=-4123, _
  SearchOrder:=1, _
  SearchDirection:=2, _
  MatchCase:=False).Row
End With[blue]
lngLastRow = lngLastRow + 1[/blue]

Does it have a value of the empty (last) Row where you want to add your new data?

Have fun.

---- Andy

There is a great need for a sarcasm font.

 

[irethedo]

Thanks Andy

lngLastRow = 7 which is the first blank row after the contents in the spreadsheet where I want the append to start.

however, lngLastRow = lngLastRow + 1 = FALSE which is probably why it is failing.

UPDATE- My bad, the false is sown in the watch window for lngLastRow + 1 and there was a capy of the spreadsheet open

 

[Andrzejek]

If the [blue][tt]lngLastRow = 7[/tt][/blue], your code pretty much does this:

With objSht
  .Range("A[blue]7[/blue]").CopyFromRecordset rs1
...

So the data from the recordset [tt]rs1[/tt] is displayed (copied) starting in cell A7. Right?

Have fun.

---- Andy

There is a great need for a sarcasm font.