將字符集更改爲UTF-8

所以我有這個腳本很棒，但我需要一個額外的選項。我有一個具有特定主題的傳入郵件規則，它使用下面的腳本。它可能導出到.msg使用utf-8？將字符集更改爲UTF-8

Sub MySubroutineName(Item As Outlook.MailItem) 
    MessageAndAttachmentProcessor Item, , True, , , , True 
End Sub

以上是實際腳本的子程序。

Public Declare Function GetProfileString Lib "kernel32" Alias "GetProfileStringA" _ 
    (ByVal lpAppName As String, ByVal lpKeyName As String, _ 
    ByVal lpDefault As String, ByVal lpReturnedString As String, _ 
    ByVal nSize As Long) As Long 

Private Declare Function ShellExecute Lib "shell32.dll" _ 
    Alias "ShellExecuteA" (ByVal hwnd As Long, ByVal lpOperation As String, _ 
    ByVal lpFile As String, ByVal lpParameters As String, _ 
    ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long 

Sub MessageAndAttachmentProcessor(Item As Outlook.MailItem, _ 
Optional bolPrintMsg As Boolean, _ 
Optional bolSaveMsg As Boolean, _ 
Optional bolPrintAtt As Boolean, _ 
Optional bolSaveAtt As Boolean, _ 
Optional bolInsertLink As Boolean, _ 
Optional strAttFileTypes As String, _ 
Optional strFolderPath As String, _ 
Optional varMsgFormat As OlSaveAsType, _ 
Optional strPrinter As String) 

Dim olkAttachment As Outlook.Attachment, _ 
    objFSO As Object, _ 
    strMyPath As String, _ 
    strExtension As String, _ 
    strFileName As String, _ 
    strOriginalPrinter As String, _ 
    strLinkText As String, _ 
    strRootFolder As String, _ 
    strTempFolder As String, _ 
    varFileType As Variant, _ 
    intCount As Integer, _ 
    intIndex As Integer, _ 
    arrFileTypes As Variant 

Set objFSO = CreateObject("Scripting.FileSystemObject") 
strTempFolder = Environ("TEMP") & "\" 

If strAttFileTypes = "" Then 
    arrFileTypes = Array("*") 
Else 
    arrFileTypes = Split(strAttFileTypes, ",") 
End If 

If bolPrintMsg Or bolPrintAtt Then 
    If strPrinter <> "" Then 
     strOriginalPrinter = GetDefaultPrinter() 
     SetDefaultPrinter strPrinter 
    End If 
End If 

If bolSaveMsg Or bolSaveAtt Then 
    If strFolderPath = "" Then 
     strRootFolder = "S:\mail\" 
    Else 
     strRootFolder = strFolderPath & IIf(Right(strFolderPath, 1) = "\", "", "\") 
    End If 
End If 

If bolSaveMsg Then 
    Select Case varMsgFormat 
     Case olHTML 
      strExtension = ".HTML" 
     Case olMSG 
      strExtension = ".MSG" 
     Case olRTF 
      strExtension = ".RTF" 
     Case olDoc 
      strExtension = ".DOC" 
     Case olTXT 
      strExtension = ".TXT" 
     Case Else 
      strExtension = ".MSG" 
    End Select 
    Item.SaveAs strRootFolder & RemoveIllegalCharacters(Item.Subject) & strExtension, varMsgFormat 
End If 

For intIndex = Item.Attachments.Count To 1 Step -1 
    Set olkAttachment = Item.Attachments.Item(intIndex) 
    'Print the attachments if requested' 
    If bolPrintAtt Then 
     If olkAttachment.Type <> olEmbeddeditem Then 
      For Each strFileType In arrFileTypes 
       If (strFileType = "*") Or (LCase(objFSO.GetExtensionName(olkAttachment.FileName)) = LCase(strFileType)) Then 
        olkAttachment.SaveAsFile strTempFolder & olkAttachment.FileName 
        ShellExecute 0&, "print", strTempFolder & olkAttachment.FileName, 0&, 0&, 0& 
       End If 
      Next 
     End If 
    End If 
    'Save the attachments if requested' 
    If bolSaveAtt Then 
     strFileName = olkAttachment.FileName 
     intCount = 0 
     Do While True 
      strMyPath = strRootFolder & strFileName 
      If objFSO.FileExists(strMyPath) Then 
       intCount = intCount + 1 
       strFileName = "Copy (" & intCount & ") of " & olkAttachment.FileName 
      Else 
       Exit Do 
      End If 
     Loop 
     olkAttachment.SaveAsFile strMyPath 
     If bolInsertLink Then 
      If Item.BodyFormat = olFormatHTML Then 
       strLinkText = strLinkText & "<a href=""file://" & strMyPath & """>" & olkAttachment.FileName & "</a><br>" 
      Else 
       strLinkText = strLinkText & strMyPath & vbCrLf 
      End If 
      olkAttachment.Delete 
     End If 
    End If 
Next 

If bolPrintMsg Then 
    Item.PrintOut 
End If 

If bolPrintMsg Or bolPrintAtt Then 
    If strOriginalPrinter <> "" Then 
     SetDefaultPrinter strOriginalPrinter 
    End If 
End If 

If bolInsertLink Then 
    If Item.BodyFormat = olFormatHTML Then 
     Item.HTMLBody = Item.HTMLBody & "<br><br>Removed Attachments<br><br>" & strLinkText 
    Else 
     Item.Body = Item.Body & vbCrLf & vbCrLf & "Removed Attachments" & vbCrLf & vbCrLf & strLinkText 
    End If 
    Item.Save 
End If 

Set objFSO = Nothing 
Set olkAttachment = Nothing 
End Sub 

Function GetDefaultPrinter() As String 
Dim strPrinter As String, _ 
    intReturn As Integer 
strPrinter = Space(255) 
intReturn = GetProfileString("Windows", ByVal "device", "", strPrinter, Len(strPrinter)) 
If intReturn Then 
    strPrinter = UCase(Left(strPrinter, InStr(strPrinter, ",") - 1)) 
End If 
GetDefaultPrinter = strPrinter 
End Function 

Function RemoveIllegalCharacters(strValue As String) As String 
' Purpose: Remove characters that cannot be in a filename from a string.' 
' Written: 4/24/2009' 
' Author: BlueDevilFan' 
' Outlook: All versions' 
RemoveIllegalCharacters = strValue 
RemoveIllegalCharacters = Replace(RemoveIllegalCharacters, "<", "") 
RemoveIllegalCharacters = Replace(RemoveIllegalCharacters, ">", "") 
RemoveIllegalCharacters = Replace(RemoveIllegalCharacters, ":", "") 
RemoveIllegalCharacters = Replace(RemoveIllegalCharacters, Chr(34), "'") 
RemoveIllegalCharacters = Replace(RemoveIllegalCharacters, "/", "") 
RemoveIllegalCharacters = Replace(RemoveIllegalCharacters, "\", "") 
RemoveIllegalCharacters = Replace(RemoveIllegalCharacters, "|", "") 
RemoveIllegalCharacters = Replace(RemoveIllegalCharacters, "?", "") 
RemoveIllegalCharacters = Replace(RemoveIllegalCharacters, "*", "") 
End Function 

Sub SetDefaultPrinter(strPrinterName As String) 
Dim objNet As Object 
Set objNet = CreateObject("Wscript.Network") 
objNet.SetDefaultPrinter strPrinterName 
Set objNet = Nothing 
End Sub

來源

2016-08-16 Paul

請確保您使用olMsgUnicode格式，而不是olMsg。

來源

2016-08-16 16:10:15

將字符集更改爲UTF-8

回答

相關問題