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

次週の講座予定は、今週の「今週の講座予定」をコピペして修正しているが、“p1” “p2” など一意なリンクが設定されているのでこの修正が意外と面倒だ。そこで、

1. 1. 「今週の講座予定」の記事（ソース）をメモ帳に貼り付けて保存
   2. 保存したメモ帳をエクセルＶＢＡで修正
   3. 修正したメモ帳を「はてな」に貼り付ける

ようにした。以下は Excel VBA のソース。まだ機能不足のところがあるが、今後の参考にするためアップした。

Option Explicit
Const MYObjName = "modEdit今週の講座予定"

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"
        'Excelﾌｧｲﾙのﾊﾟｽを取得
    strPath = ThisWorkbook.Path
        '入力ﾃｷｽﾄﾌｧｲﾙはﾀﾞｲｱﾛｸﾞﾎﾞｯｸｽから
    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)
    
    Do Until TS1.AtEndOfStream
        strData = TS1.ReadLine
        If Left(strData, 1) = "*" And Left(strData, 2) <> "**" Then
            i = InStr(2, strData, "*", vbBinaryCompare)
            If i <= 12 Then
                strData = Mid(strData, i)
            End If
        End If
        TS2.WriteLine strData
    Loop
    TS1.Close: TS2.Close
    
Exit_Auto_Open:
    Set FSO = Nothing
    ThisWorkbook.Close
    Exit Sub
    
Err_Auto_Open:
    MsgBox Err.Number & "/" & Err.Description, vbCritical, mbTitle
    Resume Exit_Auto_Open
End Sub

1. Excel を閉じるコードが解らない