Need macro to avoid 4248 run-time error

Question

Hi there,

In another post here (closed to replies), Jay Freedman helpfully provided a macro sequence to open a Word document in Draft view. One part of the sequence is a time delay to avoid the 4248 error, but when I start Word (Word 2016), I still get the error. Possibly it would be better to have an If, Then for the existence of an active window---if the window doesn't exist, then exit sub? Not sure how to write it. Here's the code he provided:

Sub ForceDraftView()

    ActiveWindow.View.Draft = True

End Sub

Sub AutoNew()

    ForceDraftView

End Sub

Sub AutoOpen()

    ForceDraftView

End Sub

Sub AutoExec()

  Application.OnTime DateAdd("s", 1, Now), "ForceDraftView"

End Sub

The first macro does the work of switching the view to Draft. The AutoNew macro runs when you click File > New or press Ctrl+N in a running copy of Word. The AutoOpen macro runs when you open any existing document. The odd one, AutoExec, runs when Word starts; because there is no active window yet when the macro runs, the OnTime function causes one second to elapse before it calls the ForceDraftView macro.

Answer 1

The code is old style and not compatible with Word 2016 (I've made some tests and found that it doesn't work on my machines in all cases).

I suggest to delete the code and use the code below instead, must be placed into the code module ThisDocument.

Andreas.

Option Explicit

Dim WithEvents App As Application

Private Sub Document_Open()
  Set App = Application
End Sub

Private Sub App_DocumentOpen(ByVal Doc As Document)
  ForceDraftView Doc.ActiveWindow
End Sub

Private Sub App_NewDocument(ByVal Doc As Document)
  ForceDraftView Doc.ActiveWindow
End Sub

Private Sub App_WindowActivate(ByVal Doc As Document, ByVal Wn As Window)
  ForceDraftView Wn
End Sub

Private Sub ForceDraftView(ByVal W As Window)
  If W Is Nothing Then Set W = ActiveWindow
  W.View.Draft = True
End Sub

Answer 2

You can always tap the error and take required action. For example, if you can use

On Error Resume Next

If Err.Number <> 0 Then

Instructions

End If