One Access record updated to subsequent Excel row



I have one recurring problem with this program. The user updates an Access
db one record at a time. I want the records added one at a time to the
Excel sheet.
Right now it does it but it writes over the first record, and always stays
on the first row. I want it to add the next record in the Else clause to the
subsequent row in the sheet. I can't see why it doesn't offset the rows by 1
for each update?

thanking you in advance.

Private Sub Form_AfterUpdate()

Dim fso As Object
Dim appExcel As Excel.Application
Dim wbk As Excel.Workbook
Dim wks As Excel.Worksheet
Dim EndRow As Long
Dim SOrgPath As String
Dim SPath As String

Dim dbs As DAO.Database
Dim rst As DAO.Recordset
'Remember original default path

'Set the new path

'Check if directory exists if not create it
If Dir("c:\Test", vbDirectory) = "" Then
MkDir "c:\Test"
ChDir "c:\Test"
End If

'Check if Excel object is created if not create it
Set fso = CreateObject("Scripting.FileSystemObject")
If Not fso.FileExists("c:\Test\Employees.xls") Then
Set appExcel = New Excel.Application
appExcel.Application.Visible = True
appExcel.DisplayAlerts = False
Set wbk = appExcel.Workbooks.Add
Set wks = appExcel.Worksheets(1)
wks.Name = "Emp"

Cells(1, 1).Value = Me.Form.ID
Cells(1, 2).Value = Me.Form.FirstName
Cells(1, 3).Value = Me.Form.Salary

wbk.SaveAs ("C:\Test\Employees.xls")
Set dbs = Nothing
Set fso = Nothing


Set appExcel = Excel.Application
appExcel.Visible = True
appExcel.DisplayAlerts = False

Set wbk = appExcel.Workbooks.Open("Employees.xls")

Set wks = appExcel.Worksheets("Emp")


EndRow = Cells(Rows.Count, 1).End(xlUp)
Debug.Print EndRow
Cells(EndRow + 1, 1).Value = Me.Form.ID
Cells(EndRow + 1, 2).Value = Me.Form.FirstName
Cells(EndRow + 1, 3).Value = Me.Form.Salary
Debug.Print EndRow
wbk.SaveAs ("c:\Test\Employees.xls")

End If

appExcel.DisplayAlerts = True
End Sub


Hiya Janis,
I'm here again
I dunno why the way to find the first empty row doesn't work always so amend
your code in this way:
substitute this line EndRow = Cells(Rows.Count, 1).End(xlUp)
with those

Cells(Rows.Count, 1).Select
EndRow = ActiveCell.Row

and remember to specify the full path of the file in this line
Set wbk = appExcel.Workbooks.Open("Employees.xls")
so the line must become
Set wbk = appExcel.Workbooks.Open("c:\test\Employees.xls")
I explained that more verbosely answering your previuos post.

Regards Paolo

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question