how to reopen the same sheet in Access not a different one

  • Thread starter Thread starter Guest
  • Start date Start date
G

Guest

I have another problem with this code. The first time I save the file it
saves in the If
clause. The second time I try to add another row to the sheet in the Else
clause it says do Employees.xls is already open. Reopening will cause any
changes you made to be discarded. Do you want to reopen?

How can I just add to the same sheet, in other words if it is not open, then
open it and add to the next row after the last record.

Many thanks,

Private Sub Form_AfterUpdate()


'*******************************************************************
'Purpose: To update an Excel spreadsheet with each subsequent record
'*******************************************************************





Dim fso As Object
Dim appExcel As Excel.Application
Dim wbk As Excel.Workbook
Dim wks As Excel.Worksheet
Dim i As Integer
Dim EndRow As Long

Dim dbs As DAO.Database
Dim rst As DAO.Recordset

'Check if directory exists if not create it
If Dir("c:\Test", vbDirectory) = "" Then
MkDir "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"
wks.Activate

EndRow = Range("A65536").End(xlUp).Select

Range("a1").Offset(0, EndRow + 1).Value = Me.Form.ID
Range("B1").Offset(0, EndRow + 1).Value = Me.Form.FirstName
Range("C1").Offset(0, EndRow + 1).Value = Me.Form.Salary
wbk.SaveAs ("c:\test\Employees.xls")

Set dbs = Nothing
Set fso = Nothing

Else
' With ActiveWorkbook
' Close
' End With
Set appExcel = Excel.Application
appExcel.Visible = True
Set wbk = appExcel.Workbooks.Open("Employees.xls")

Set wks = appExcel.Worksheets("Emp")

wks.Activate

EndRow = Range("A65536").End(xlUp).Select

Range("a1").Offset(0, EndRow + 1).Value = Me.Form.ID
Range("B1").Offset(0, EndRow + 1).Value = Me.Form.FirstName
Range("C1").Offset(0, EndRow + 1).Value = Me.Form.Salary





End If
appExcel.DisplayAlerts = True
End Sub
 
Hi Janis,

I reviewed your code and now it works in the way you expect (I think)

Dim fso As Object
Dim appExcel As Excel.Application
Dim wbk As Excel.Workbook
Dim wks As Excel.Worksheet
Dim i As Integer
Dim EndRow As Long
Dim dbs As DAO.Database
Dim rst As DAO.Recordset

'Check if directory exists if not create it
If Dir("c:\Test", vbDirectory) = "" Then
MkDir "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"
wks.Activate
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")
wbk.Close
appExcel.Quit
Set dbs = Nothing
Set fso = Nothing
Else
Set appExcel = Excel.Application
appExcel.Visible = True
appExcel.DisplayAlerts = False
Set wbk = appExcel.Workbooks.Open("c:\test\Employees.xls")
Set wks = appExcel.Worksheets("Emp")
wks.Activate
EndRow = Cells(Rows.Count, 1).End(xlUp)
Cells(EndRow + 1, 1).Value = Me.Form.id
Cells(EndRow + 1, 2).Value = Me.Form.Firstname
Cells(EndRow + 1, 3).Value = Me.Form.Salary
wbk.SaveAs ("c:\test\Employees.xls")
wbk.Close
appExcel.Quit
End If
appExcel.DisplayAlerts = True

HTH Paolo
 
thanks, that is awesome.

Paolo said:
Hi Janis,

I reviewed your code and now it works in the way you expect (I think)

Dim fso As Object
Dim appExcel As Excel.Application
Dim wbk As Excel.Workbook
Dim wks As Excel.Worksheet
Dim i As Integer
Dim EndRow As Long
Dim dbs As DAO.Database
Dim rst As DAO.Recordset

'Check if directory exists if not create it
If Dir("c:\Test", vbDirectory) = "" Then
MkDir "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"
wks.Activate
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")
wbk.Close
appExcel.Quit
Set dbs = Nothing
Set fso = Nothing
Else
Set appExcel = Excel.Application
appExcel.Visible = True
appExcel.DisplayAlerts = False
Set wbk = appExcel.Workbooks.Open("c:\test\Employees.xls")
Set wks = appExcel.Worksheets("Emp")
wks.Activate
EndRow = Cells(Rows.Count, 1).End(xlUp)
Cells(EndRow + 1, 1).Value = Me.Form.id
Cells(EndRow + 1, 2).Value = Me.Form.Firstname
Cells(EndRow + 1, 3).Value = Me.Form.Salary
wbk.SaveAs ("c:\test\Employees.xls")
wbk.Close
appExcel.Quit
End If
appExcel.DisplayAlerts = True

HTH Paolo
Click to expand...
 
Back
Top