次週の講座予定の記事を作るエクセルVBA（改訂）

前回を改訂し、次の機能を追加した。

1. 1. マクロ終了前に、出力したテキストファイルを関連付けられたアプリケーションで開く。
      • moug 即効テクニックにあったコード。
   2. マクロ終了時、エクセルも終了する。
      • これもインターネットにあったコードを真似た。

Option Explicit
Const MYObjName = "modEdit今週の講座予定"
Dim STRAns As String
    'ファイルオープン/表示/印刷関数(API)の宣言
Declare Function ShellExecute Lib "SHELL32" Alias "ShellExecuteA" _
    (ByVal hwnd&, ByVal lpOperation$, ByVal lpFile$, _
    ByVal lpParameters$, ByVal lpDirectory$, ByVal nShowCmd&) As Long

    '指定ファイルを関連付けられたアプリケーションで開く関数
Public Sub OpenFile(strPath As String)
Dim hWndAccessApp As Long
        '現在の位置とサイズで表示 5(SW_SHOW)
    Call ShellExecute(hWndAccessApp, "open", strPath, vbNullString, "", 5)
End Sub

Public Sub Auto_Open()
'On Error GoTo Err_Auto_Open
Dim mbTitle As String
Dim FSO As New FileSystemObject
Dim TS1 As TextStream, TS2 As TextStream
Dim TX1File As String, TX2File As String
Dim i As Long
Dim strData As String, strPath As String
    
    mbTitle = MYObjName & "/Auto_Open"
        'このブックのパスを取得する。
    strPath = ThisWorkbook.Path
        'ﾌｧｲﾙを開くダイアログボックスを表示する。
    i = InStr(strPath, ":")
    If i > 1 Then
        STRAns = Left(strPath, i - 1)
        ChDrive STRAns
        ChDir strPath
    End If
    TX1File = Application.GetOpenFilename("ﾃｷｽﾄﾌｧｲﾙ,*.txt")
        '［ｷｬﾝｾﾙ］したら終わる。
    If TX1File = "False" Then GoTo Exit_Auto_Open
        '同じパスを出力ファイルに付与する。
    i = InStrRev(TX1File, "\", -1, vbBinaryCompare)
    TX2File = Left(TX1File, i) & "Edit今週の講座予定.txt"
        'ファイルを開く。
    Set TS1 = FSO.OpenTextFile(TX1File, ForReading)
    Set TS2 = FSO.CreateTextFile(TX2File, True)
        '*p1* のケースのみ *p1 を取る。
    Do Until TS1.AtEndOfStream
        strData = TS1.ReadLine
        If (Left(strData, 1) = "*") And (Left(strData, 2) <> "**") Then
            i = InStr(2, strData, "*", vbBinaryCompare)
            If (i > 0) And (i <= 12) Then strData = Mid(strData, i)
        End If
        TS2.WriteLine strData
    Loop
    TS1.Close: TS2.Close
    DoEvents
        'TX2File(テキストファイル)を開く
    OpenFile TX2File
    
Exit_Auto_Open:
    Set FSO = Nothing
        'Excel を閉じる。このコードは、インターネットより拾ってきた。
    If Workbooks.Count <= 1 Then Application.Quit
        '本ブックをClose
    ThisWorkbook.Close False
    Exit Sub
    
Err_Auto_Open:
    MsgBox Err.Number & "/" & Err.Description, vbCritical, mbTitle
    Resume Exit_Auto_Open
End Sub