Excel not visible after Opened by Word
Hi all,
I have a word document macro that opens an excel file and inserts info into the next empty row. It works fine at home on Office Mac 2011 but not on Office 2007 at work (PC based). At home everything works as it should, however at work, the excel file is populated by the data but excel is never visible. I have to open another excel file - and then the file I have updated using the macro becomes visible with the new data in it (and saved). Any ideas?
Code:
Sub sendToOSheet()
Dim serialNum As Long
Dim searchDate As String
Dim IMS As String
Dim officer As String
Dim SDFullName As String
Dim SDDoB As String
'Dim DocPath As String
Dim oXL As Excel.Application, oWB As Excel.Workbook, Sht As Excel.Worksheet
Dim WorkbookToWorkOn As String, ExcelWasNotRunning As Boolean, oERng As Excel.Range
'DocPath = ThisDocument.Path & "\" & ThisDocument.Name
'If Excel is running, get a handle on it; otherwise start a new instance of Excel.
'Set the ExcelWasRunning value to indicate whether Excel was running so we know whether to close it or not later.
On Error Resume Next 'an err will occur if Excel isnt running.
Set oXL = GetObject(, "Excel.Application")
If Err Then
ExcelWasNotRunning = True
Set oXL = New Excel.Application
Error = 0 'reset error to nothing
Else: ExcelWasNotRunning = False
End If
'Set an error handler in case a problem occurs later
'On Error GoTo Err_Handler
'Initialize Excel variables for the workbook,sheet & 1st blank row in col A
'WorkbookToWorkOn = "Storage:Users:Dave:Documents:Test:New Shizzle:OB SS.xlsx"
oXL.ScreenUpdating = False
Set oWB = oXL.Workbooks.Open("Storage:Users:Dave:Documents:Test:New Shizzle:OB SS.xlsx")
Set Sht = oWB.Sheets("Sheet1") '1st blank row in col A. Presumes something is already in cell A1.
Set oERng = Sht.Range("A65536").End(xlUp)(2, 1)
Sht.Activate
serialNum = oERng.Offset(-1, 0).Value + 1
searchDate = Format(Date, "dd.mm.yyyy")
IMS = removeCellMarkers(ActiveDocument.Bookmarks.item("IMSReference").Range)
'below tests usernames
'officer = "Susanne"
'officer = "Michele"
officer = Application.UserName
SDFullName = removeCellMarkers(ActiveDocument.Bookmarks("SDFirstName").Range) & " " & removeCellMarkers(ActiveDocument.Bookmarks("SDSurname").Range)
SDDoB = removeCellMarkers(ActiveDocument.Bookmarks("SDDoB").Range)
'assign values to cells
oERng.Offset(0, 0).Value = serialNum
oERng.Offset(0, 1).Value = searchDate
oERng.Offset(0, 2).Value = IMS
oERng.Offset(0, 3).Value = officer
oERng.Offset(0, 4).Value = SDFullName
oERng.Offset(0, 5).Value = SDDoB
oERng.Offset(0, 6).Value = "Y"
oERng.Offset(0, 8).Value = "Research"
oERng.Offset(0, 9).Value = "No family"
'Save changes
oWB.Save
oXL.ScreenUpdating = True
'Release Excel object references from memory
Set oERng = Nothing
Set Sht = Nothing
Set oWB = Nothing
Set oXL = Nothing
'Exit procedure. Required else error message will appear even when there 'wasnt an error.
Exit Sub
'Error message if an error occurs.
Err_Handler: MsgBox WorkbookToWorkOn & " caused a problem. " & Err.Description, vbCritical, _
"Error: " & Err.Number
If ExcelWasNotRunning Then
oXL.Quit
End If
'Release Excel object references from memory
Set oERng = Nothing
Set Sht = Nothing
Set oWB = Nothing
Set oXL = Nothing
End Sub
Thanks in advance,
Dave.
