VBA读取Outlook的签名文件

Sub TEST01()
Dim oApp       As Outlook.Application
Dim objMAIL    As Outlook.MailItem
Dim strMOJI(1) As String
Dim n          As Long
Dim strDate  As String
Dim strLastWeekBegin As String
Dim strLastWeekEnd As String
Dim SigString As String


strDate = Date   'ｵｱﾇｰﾈﾕﾆﾚ
strDate = Replace(strDate, "-", "")
strLastWeekBegin = Date - 7
strLastWeekBegin = Replace(strLastWeekBegin, "-", "")
strLastWeekEnd = Date - 2
strLastWeekEnd = Replace(strLastWeekEnd, "-", "")
 
SigString = "C:\Documents and Settings\" & Environ("username") & _
"\Application Data\Microsoft\Signatures\mySign.htm"


If Dir(SigString) <> "" Then
    SigString = GetBoiler(SigString)
Else
    SigString = ""
End If
    
On Error Resume Next
Set oApp = GetObject(, "Outlook.Application")
On Error GoTo 0
If oApp Is Nothing Then
    Set oApp = CreateObject("Outlook.Application")
    oApp.GetNamespace("MAPI").GetDefaultFolder(6).display
End If


Set objMAIL = oApp.CreateItem(0)
strMOJI(0) = "ｸｻﾁ・ｼ｣ｬﾉﾏﾎ郤ﾃ｣ｺ" & "
" & _
             "ｸｽｼﾖﾐﾊﾇﾉﾏﾖﾜｵﾄﾏ鍗ｿｽﾈｱｨｸ譽ｬﾇ・鰆ﾄ｡｣" & "
" & _
             "ﾐｻﾐｻ｣｡" & "
"
strMOJI(1) = SigString
objMAIL.To = "[email protected]"
objMAIL.Subject = "ﾏ鍗ｿｽﾈｱｨｸ・ & "(" & strLastWeekBegin & "-" & strLastWeekEnd & ")"
objMAIL.BodyFormat = 2 'HTMLﾐﾎﾊｽ
objMAIL.HTMLBody = strMOJI(0) & "
" & strMOJI(1)
objMAIL.Attachments.Add "C:\Test.doc", olByValue, 1, "Test"    'ｸｽｼ


objMAIL.display




'n = Len(strMOJI(0))
'ActiveSheet.Range("A1:D10").Copy
'oApp.ActiveInspector.WordEditor.Range(n, n).Paste
'Application.CutCopyMode = False


Set objMAIL = Nothing
Set oApp = Nothing
End Sub




Function GetBoiler(ByVal sFile As String) As String
    Dim fso As Object
    Dim ts As Object
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set ts = fso.GetFile(sFile).OpenAsTextStream(1, -2)
    GetBoiler = ts.readall
    ts.Close
End Function