Excel显示垃圾字符

我在Outlook中编写了一个脚本来导出选定的电子邮件到Excel。

任何人都可以帮助我configurationExcel或我的代码可能需要什么变化，以便它不显示下面的屏幕截图的垃圾邮件？

在一台电脑上显示正确，但没有显示。

以下是我的代码：

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 =分享

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 

或者在outlook中，在这行之后oWS.Cells(LastRow, "D") = Body

添加这一行

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