Question

我在outlook中编写了一个脚本，将Selected Email导出为excel。

有人可以帮我配置Excel或我的代码中可能需要进行哪些更改，以便它不会显示下面的截图等垃圾字符？

enter image description here

在一台电脑中，它显示正确但不在其他电脑中。

以下是我的代码：

Const ExcelPath = "c:\outlook\outlook_emails.xlsx"

Sub Export_To_Excel()
    Dim oMail As Outlook.MailItem
    Set oMail = GetCurrentItem

    If oMail Is Nothing Then
        MsgBox "No or Invalid Item selected", vbCritical
        Exit Sub
    End If

    On Error GoTo Err_H

    ' Get Email Info
    Email = GetSmtpAddress(oMail)
    Body = Replace(oMail.Body, Chr(9), vbCrLf)
    Subject = Replace(oMail.Subject, Chr(9), vbCrLf)

    ' Export to Excel
    Set oExcel = CreateObject("Excel.Application")
    Set oWB = oExcel.Workbooks.Open(ExcelPath)
    Set oWS = oWB.Sheets(1)
    LastRow = oWS.Cells(oWS.Rows.Count, "A").End(-4162).Row + 1
    oWS.Cells(LastRow, "A") = Format(LastRow - 1, "###")
    oWS.Cells(LastRow, "B") = Email
    oWS.Cells(LastRow, "D") = Body
    oWS.Cells(LastRow, "C") = Subject
    oWS.Cells.RowHeight = 17
    oWS.UsedRange.Font.Name = "Calibri"
    oWS.UsedRange.Font.Size = 8
    oWB.Close True
    Set oExcel = Nothing: Set oWS = Nothing: Set oWB = Nothing

    MsgBox "Successfully exported Email Info exported to Excel", vbInformation
    Exit Sub

Err_H:
    MsgBox Err.Description, vbCritical, "Something Went Wrong"
    Set oExcel = Nothing: Set oWS = Nothing: Set oWB = Nothing
End Sub

Private Function GetCurrentItem() As Outlook.MailItem
    Dim objApp As Outlook.Application
    Set objApp = Application

    On Error GoTo Err_H
    Select Case TypeName(objApp.ActiveWindow)
        Case "Explorer"
            Set GetCurrentItem = objApp.ActiveExplorer.Selection.item(1)

        Case "Inspector"
            Set GetCurrentItem = objApp.ActiveInspector.CurrentItem

        Case Else
            Set GetCurrentItem = Nothing
    End Select
    Exit Function

Err_H:
    Set GetCurrentItem = Nothing
End Function

Private Function GetSmtpAddress(ByVal item As Outlook.MailItem) As String
    Dim sAddress As String
    Dim recip As Outlook.Recipient
    Dim exUser As Outlook.ExchangeUser
    Dim oOutlook As Outlook.Application
    Dim oNS As Outlook.NameSpace

    Set oOutlook = New Outlook.Application
    Set oNS = oOutlook.GetNamespace("MAPI")
    If UCase$(item.SenderEmailType) = "EX" Then
        Set recip = oNS.CreateRecipient(item.SenderEmailAddress)
        Set exUser = recip.AddressEntry.GetExchangeUser()
        sAddress = exUser.PrimarySmtpAddress
    Else
        sAddress = item.SenderEmailAddress
    End If
    GetSmtpAddress = sAddress
    Set oNS = Nothing
    Set oOutlook = Nothing
End Function

链接到更大的图片：https://drive.google.com/file/d/0Bwjl0SErKySTMmkwZ21zOXhJSEU/edit?usp=sharing

Answer 1

您的单元格具有特殊字符Chr(160)。试试这个

Option Explicit

Sub Sample()
    Dim ws As Worksheet

    Set ws = ThisWorkbook.Sheets("Sheet1")

    With ws
        .Columns(4).Replace What:=Chr(160), Replacement:="", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
    End With
End Sub

或在展望中，在此行之后oWS.Cells(LastRow, "D") = Body

添加此行

oWS.Cells(LastRow, "D").Replace What:=Chr(160), Replacement:="", LookAt:=2, _
SearchOrder:=1, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False

Excel显示垃圾字符

1 个答案: