Export a record to an open Excel workbook. (1 Viewer)

ugly

New member
Local time
Today, 09:01
Joined
Jan 31, 2009
Messages
6
I am trying to export a record from an Access form to the workbook in Excel. There is no problem when the workbook is not open, but I would like to keep on exporting to the workbook when it is open. I can not figure out to do this without Excel opening a new workbook. Thanks in advance. Here is my code so far:
Code:
Private Sub ExportToExcel_Click()
On Error GoTo Err_ExportToExcel_Click
Dim objXL As Object
Dim xlWB As Object
Dim xlWS As Object
Dim i As Integer
On Error Resume Next
Err.Clear
'Open the workbook if not open.
If Err.Number <> 0 Then
  MsgBox "Not Open"
  Set objXL = CreateObject("Excel.Application")
  objXL.Visible = True
  Set xlWB = objXL.Workbooks.Open("C:\Ordrebekreftelser\oppsettordre.xls")
  SetAttr "C:\Ordrebekreftelser\oppsettordre.xls", vbNormal
  Set xlWS = xlWB.Worksheets(1)
  i = xlWS.UsedRange.Rows.Count + 1
Else
    
    MsgBox "Open"
    i = xlWS.UsedRange.Rows.Count + 1
    
    'If the workbook is already open, then export the current record to the open workbook.
    
    'How do I do this???
       
End If
On Error GoTo 0
 
'MsgBox xlWS.UsedRange.Rows.Count
' assign records to specific cells
  xlWS.Range("A" & i).Value = Me.OrgNr
  xlWS.Range("B" & i).Value = Me.Firmanavn
  xlWS.Range("C" & i).Value = Me.KontaktPerson
  xlWS.Range("D" & i).Value = Me.Pris
  xlWS.Range("E" & i).Value = Me.Dato
  xlWS.Range("F" & i).Value = ""
  xlWS.Range("G" & i).Value = "Jørn Madsen"
  xlWS.Range("H" & i).Value = Me.Epostadresse
  xlWS.Range("I" & i).Value = Me.Postadresse
  xlWS.Range("J" & i).Value = Me.Postnummer
  xlWS.Range("K" & i).Value = Me.Poststed
  xlWS.Range("L" & i).Value = Me.Kommentarer
  xlWS.Range("M" & i).Value = ""
  
'xlWB.SaveAs "C:\Ordrebekreftelser\oppsettordre.xls" 'Save the Excel file
xlWB.Save
'xlWB.Close 'Close the Excel file.
'objXL.Application.Quit
Set objXL = Nothing 'Destroy the Excel object created by the program to free up memory space.
Set xlWB = Nothing
Set xlWS = Nothing
Exit_ExportToExcel_Click:
    Exit Sub
Err_ExportToExcel_Click:
    MsgBox Err.Description
    Resume Exit_ExportToExcel_Click
    
End Sub
 

ajetrumpet

Banned
Local time
Today, 02:01
Joined
Jun 22, 2007
Messages
5,638
I do not know either, because every instance of working with Excel that I've ever used has opened the application variable and made it visible first. What you can do though, is when you open the workbook, leave it open, and create VBA loops to do everything you need to until it's all finished, and THEN close the book. If that would be too many windows, or you want it hidden, just suppress the objExl.VISIBLE = True code line so you don't see anything happening while the code is running.
 

ugly

New member
Local time
Today, 09:01
Joined
Jan 31, 2009
Messages
6
I have solved the problem. Do not know if it is a good solution, but it works. Here is the working code:

Code:
Private Sub ExportToExcel_Click()
On Error GoTo Err_ExportToExcel_Click
Dim objXL As Object
Dim xlWB As Object
Dim xlWS As Object
Dim i As Integer

On Error Resume Next
Err.Clear
Set objXL = GetObject(, "Excel.Application")
'Open the workbook if not open.
If Err.Number <> 0 Then
  Set objXL = CreateObject("Excel.Application")
  objXL.Visible = True
  Set xlWB = objXL.Workbooks.Open("C:\Ordrebekreftelser\oppsettordre.xls")
  SetAttr "C:\Ordrebekreftelser\oppsettordre.xls", vbNormal
  Set xlWS = xlWB.Worksheets(1)
  i = xlWS.UsedRange.Rows.Count + 1
Else
  objXL.Visible = True
  Set xlWB = objXL.Workbooks.Open("C:\Ordrebekreftelser\oppsettordre.xls")
  Set xlWS = xlWB.Worksheets(1)
  i = xlWS.UsedRange.Rows.Count + 1
       
End If
On Error GoTo 0
 
' assign records to specific cells
  xlWS.Range("A" & i).Value = Me.OrgNr
  xlWS.Range("B" & i).Value = Me.Firmanavn
  xlWS.Range("C" & i).Value = Me.KontaktPerson
  xlWS.Range("D" & i).Value = Me.Pris
  xlWS.Range("E" & i).NumberFormat = "dd.mm.yyyy"
  xlWS.Range("E" & i).Value = Me.Dato
  xlWS.Range("F" & i).Value = ""
  xlWS.Range("G" & i).Value = "Jørn Madsen"
  xlWS.Range("H" & i).Value = Me.Epostadresse
  xlWS.Range("I" & i).Value = Me.Postadresse
  xlWS.Range("J" & i).Value = Me.Postnummer
  xlWS.Range("K" & i).Value = Me.Poststed
  xlWS.Range("L" & i).Value = Me.Kommentarer
  xlWS.Range("M" & i).Value = ""
  
'xlWB.SaveAs "C:\Ordrebekreftelser\oppsettordre.xls" 'Save the Excel file
xlWB.Save
'xlWB.Close 'Close the Excel file.
'objXL.Application.Quit
Set objXL = Nothing 'Destroy the Excel object created by the program to free up memory space.
Set xlWB = Nothing
Set xlWS = Nothing

Exit_ExportToExcel_Click:
    Exit Sub
Err_ExportToExcel_Click:
    MsgBox Err.Description
    Resume Exit_ExportToExcel_Click
    
End Sub
 

chergh

blah
Local time
Today, 08:01
Joined
Jun 15, 2004
Messages
1,414
You don't need to use the open method if the workbook is already open you could just have:

Code:
Set xlWB = objXL.Workbooks("oppsettordre.xls")
 

ugly

New member
Local time
Today, 09:01
Joined
Jan 31, 2009
Messages
6
Thank you for that advise. I will try out that solution.
 

Users who are viewing this thread

Top Bottom