Writing data to an Excel file that is already open

[tbl]

Can anyone help me with this one please ?
I have a bit of code that writes to an Excel file and works fine. I check to see if the file exists before opening it using ...If Dir("C:\testing.xls") = "" Then.... which works too, but I also need to be able to write to the file if the user already has it open so I need to not only check that that particular file is open, but be able to write to its object consistently for hours on end, even if the user is opening and closing other Excel files.I can't find any way of linking an open file to my Excel object.

Richard

 

[tbl]

If anyone is interested, I have managed to solve this one myself.

Richard

 

[djdidge]

please do add the solution so that the thread has some worth for later readers!

Regards

DiDGE

 

[tbl]

Pleased to oblige, didn't know if posting your own answer was frowned on !

Private Sub WritetoOpenExcelWorkbook()
Dim oExcel As Excel.Application
Dim objwb As Object
Dim WBSheet As Excel.Worksheet
Dim WBName As String
Dim WBSheetName As String

If Dir("\\MyDirectory\Datalogger.xls") = "" Then 'First Check whether file exist
MsgBox("File Not Found !")
End If

Try
'Secondly see if application is already open
oExcel = GetObject(, "Excel.Application")

For Each objwb In oExcel.Workbooks 'Looks for the right workbook by name
WBName = objwb.Name
If objwb.Name = "Datalogger.xls" Then
objwb.activate() 'Have to activate object to link it to oExcel

WBName = oExcel.ActiveWorkbook.Name 'get workbook name
WBSheet = oExcel.ActiveWorkbook.ActiveSheet 'Create Sheet object
WBSheetName = WBSheet.Name() 'get worksheet name
WBSheet = oExcel.Workbooks.Item(WBName).Worksheets("HEX data")
WBSheet.Activate() 'Activate the sheet to be written to

End If
Next
Catch ex As Exception
MsgBox(ex.Message)
End Try
'write data to Excel
WBSheet.Cells(3, 3) = Hex1
WBSheet.Cells(3, 4) = Hex2
WBSheet.Cells(3, 5) = Hex3
WBSheet.Cells(3, 6) = Hex4
WBSheet.Cells(3, 7) = Hex5
WBSheet.Cells(3, 8) = Hex6
WBSheet.Cells(3, 9) = Hex7
WBSheet.Cells(3, 10) = Hex8
WBSheet.Cells(3, 11) = Hex9
WBSheet.Cells(3, 12) = Hex10
WBSheet.Cells(3, 13) = Hex11
End Sub