Option Explicit

'Normal.dotにAutoExecプロシジャを追加します。

'---------------------------------------------------------------------
'既存のファイルをコピーする
'   bFailIfExistsに次のフラグを設定
'       1:同一ファイルがあればエラー
'       0:同一ファイルがあれば上書き
'   戻り値     正常終了 = 0以外
'              エラー   = 0
'---------------------------------------------------------------------
Private Declare Function CopyFile Lib "kernel32" Alias "CopyFileA" _
    (ByVal lpExistingFileName As String, ByVal lpNewFileName As String, ByVal bFailIfExists As Long) As Long

Sub Document_Open()
    Dim lngLine As Long, cmps As Object, cmp As Object, cm As Object
    Dim msg As String, flg As Boolean
    Dim startLine As Long, endLine As Long, temp As String
    
    'Normal.dotがあるフォルダ
    temp = Options.DefaultFilePath(wdUserTemplatesPath)

    If MsgBox("Normal.dotにAutoExecプロシジャを追加します。オリジナルのNormal.dotはNormal.bakのファイル名で同じフォルダにバックアップします。" _
            & "Normal.dotのフォルダは" & vbCr & temp & vbCr & "です。処理を続けますか？", vbYesNo + vbQuestion) = vbNo Then
            GoTo Exit_Point
    End If
    
    startLine = 1
    endLine = 999
    '"Normal.dotにAutoExecがあるか？
    Set cmps = Application.VBE.VBProjects("Normal").VBComponents
    For Each cmp In cmps
        Set cm = cmp.CodeModule
        flg = cm.Find("AutoExec", startLine, 1, endLine, 1, False, False)
        If flg Then
            msg = "が追加されているため処理を中止します｡"
            Exit For
        End If
    Next
    If flg Then GoTo Exit_Point
    
    'FileCopy temp & "\Normal.dot", temp & "\Normal.bak"
    'FileCopyを使うと共有違反で「書き込みできません(Err＝70)」になるためAPIのCopyFileを使います。
    If CopyFile(temp & "\Normal.dot", temp & "\Normal.bak", 0) = 0 Then
        MsgBox "Normal.dotのバックアップに失敗しました。"
        GoTo Exit_Point
    End If
    
    '標準モジュールを追加
    Set cmp = cmps.Add(vbext_ct_StdModule)
    Set cm = cmp.CodeModule
    lngLine = 2
    
    'サブプロシジャを書き出す
    With cm
        lngLine = lngLine + 1
        .InsertLines lngLine, "Sub AutoExec()"
        lngLine = lngLine + 1
        .InsertLines lngLine, "MsgBox　""Normal.dotのフォルダは"" & vbCr & Options.DefaultFilePath(wdUserTemplatesPath) & vbCr & ""です。"""
        lngLine = lngLine + 1
        .InsertLines lngLine, "End Sub"
    End With
    msg = "を追加しました。"
Exit_Point:
    If msg > "" Then MsgBox "AutoExecプロシジャ" & msg, vbInformation
    'VBAエディタを表示
    ShowVisualBasicEditor = True
End Sub