利用VBA实现OUTlook发邮件，代出邮件签名功能错误

南京北京

电脑版本：WIN7
OFFICE版本：2010
问题如下：带出的签名是乱码，哪里出错了，还请高手指教，谢谢！代码如下，

Public Function SendMail(strTo As String, strSubject As String, strBody As String, Optional strAttachment As String = "", Optional strCC As String, Optional strBCC As String = "")
    On Error GoTo errHandler
    Dim objOutlook As New Outlook.Application
    Dim objMail As Mailitem
   
    Dim sigstring As String
   
    Dim Signature As String
   
    Set objOutlook = New Outlook.Application
    Set objMail = objOutlook.CreateItem(olMailitem)
    Dim strArray
    strArray = Split(strAttachment, "|")
    For i = 0 To UBound(strArray)
        objMail.Attachments.Add ThisWorkbook.Path & "\" & strArray(i)
    Next
   
    sigstring = Environ("appdata") & _
                       "\Microsoft\Signatures\111.htm"
   
    If Dir(sigstring) <> "" Then
   
        Signature = GetBoiler(sigstring)
        
    Else   
        Signature = ""      
    End If
   

    objMail.To = strTo
    objMail.CC = strCC
    If ChkEmail(strBCC) = 0 Then
        objMail.BCC = strBCC
    End If

    If strSubject <> "" Then
        objMail.Subject = strSubject
    Else
        objMail.Subject = "主题"
    End If

    '设置邮件正文
    objMail.Body = strBody & "<br><br>" & Signature
   
    With objMail
        .Send
    End With
    Set objMail = Nothing
    Set objOutlook = Nothing
    SendMail = 0
    Exit Function

errHandler:
    SendMail = 1
End Function
Function ChkEmail(str As String)
    Dim reg
    Set reg = CreateObject("vbscript.regexp")
    reg.Pattern = "^[\w.-] @[\w.-] $"
    If reg.test(str) Then
        ChkEmail = 0
    Else
        ChkEmail = 1
    End If
End Function
Sub 发送邮件()
    Dim ierr As Integer
    Dim iCount As Integer, iTotal As Integer
    Worksheets("Sheet1").Select
    Range("A2").Select
     iCount = 0
     iTotal = 0
    Do While ActiveCell.Value <> ""
        ierr = SendMail(ActiveCell.Value, ActiveCell.Offset(0, 1).Value, ActiveCell.Offset(0, 2).Value, ActiveCell.Offset(0, 3).Value, ActiveCell.Offset(0, 4).Value, ActiveCell.Offset(0, 5).Value)
        If ierr = 0 Then
            iCount = iCount + 1
        End If
        iTotal = iTotal + 1
        ActiveCell.Offset(1, 0).Select
    Loop
   
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

南京北京

来热心伙伴解答下呀~

南京北京

来个热心的伙伴解答下呀！

南京北京

问题已解决