Sub MyTask()

On Error GoTo AAA

    Const ForReading = 1

    Set objFSO = CreateObject("Scripting.FileSystemObject")

    Set objFile = objFSO.OpenTextFile("D:\Program Files\AutoHotKey\My soft\MyTask.txt", ForReading)



    Do Until objFile.AtEndOfStream

        strNextLine = objFile.ReadLine

        If Len(strNextLine) > 0 Then

            strline = strNextLine

        End If



        If Left(strline, 1) = 1 Then

            Set myOlApp = Outlook.Application

            Set myItem = myOlApp.CreateItem(olTaskItem)

            myItem.Companies = Mid(strline, 3, 2)                   '类型(单位)：灵感、兴趣、其它

            myItem.TotalWork = Mid(strline, 6, 2) * 60

            myItem.Subject = Mid(Replace(strNextLine, "<br>", " | "), 9, 25)

            myItem.Body = Now & Chr(10) & Replace(strNextLine, "<br>", Chr(10))

            myItem.Save

        ElseIf Left(strline, 1) = 2 Then

            Set myOlApp = Outlook.Application

            Set myItem = myOlApp.CreateItem(olJournalItem)

            'MsgBox Mid(strline, 3)

            myItem.Subject = Mid(Replace(strNextLine, "<br>", " "), 3)

            myItem.Body = Now & Chr(10) & Replace(strNextLine, "<br>", Chr(10))

            myItem.Type = "日志"

            myItem.Save

        End If

    Loop

    objFile.Close

    Open "D:\Program Files\AutoHotKey\My soft\MyTask.txt" For Output As #1

    Close #1

    Exit Sub

AAA:

    MsgBox "出现了一个错误，未能添加任务"

    Exit Sub

End Sub