View Single Post
  #1   Report Post  
Posted to microsoft.public.excel.programming
[email protected] newpizzaco@gmail.com is offline
external usenet poster
 
Posts: 8
Default 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