Error Executing a Macro on Opening Q
I'm hoping some one can hell with an error that has been happening on some code, that previously worked with no issue for several years.
I run a small Batch file that opens an Excel file, once the file is opened it executes a macro. As mentioned this has stopped working and now I get an error...
Runtime Error 429 "ActiveX Component Can't Create object"
My Excel Macro code is....
Option Explicit
Sub Auto_Open()
Application.ScreenUpdating = False
Dim OLKApp As Outlook.Application
Dim WeStartedIt As Boolean
Dim sh As Object
Dim Password As Object
If (Month(Now) = 12) And _
(Day(Now) = 26) Then
Exit Sub
End If
For Each sh In ActiveWorkbook.Worksheets
On Error Resume Next
sh.Unprotect Password = "1234"
sh.Unprotect
On Error GoTo 0
sh.Activate
sh.Range("A1").Select
Next sh
With ActiveWorkbook.Worksheets("Current Week")
.Activate
Application.GoTo Range("C6"), True
Range("C6").Activate
ActiveWindow.Zoom = 75
End With
On Error Resume Next
Set OLKApp = GetObject(, "Outlook.Application")
On Error GoTo 0
If OLKApp Is Nothing Then
Set OLKApp = CreateObject("Outlook.Application")
If OLKApp Is Nothing Then
' can't create app
' error mesage then exit
MsgBox "Can't Get Outlook"
Exit Sub
End If
WeStartedIt = True
Else
WeStartedIt = False
End If
Dim OkToCallMacro As Boolean 'If File is opened between 9:45am and 9:54am run the code
OkToCallMacro = False
Select Case Weekday(Date)
Case vbMonday To vbFriday
If Time = TimeSerial(9, 49, 0) _
And Time < TimeSerial(9, 54, 0) Then
OkToCallMacro = True
End If
Case Is = vbSaturday, vbSunday
If Time = TimeSerial(9, 49, 0) _
And Time < TimeSerial(9, 54, 0) Then
OkToCallMacro = True
End If
End Select
If OkToCallMacro Then
Application.WindowState = xlMinimized
Call RefreshSales
Call Copy_Paste
If Workbooks.Count = 1 Then
'only this workbook is open
ThisWorkbook.Save
'close the application
'(which will close thisworkbook)
Application.Quit
Else
ThisWorkbook.Close savechanges:=True
End If
End If
If WeStartedIt = True Then
OLKApp.Quit
End If
End Sub
|