VBAmacros – 导出CSV文件格式和扩展名不匹配

我正在使用此代码将Outlook数据(电子邮件)导出为CSV文件:

Sub ExportMessagesToExcel() Dim olkMsg As Object, _ excApp As Object, _ excWkb As Object, _ excWks As Object, _ intRow As Integer, _ intVersion As Integer, _ strFilename As String 'strFilename = InputBox("Enter a filename (including path) to save the exported messages to.", "Export Messages to Excel") strFilename = "C:...\...\Emails.csv" If strFilename <> "" Then intVersion = GetOutlookVersion() Set excApp = CreateObject("Excel.Application") Set excWkb = excApp.Workbooks.Add() Set excWks = excWkb.ActiveSheet 'Write Excel Column Headers With excWks .Cells(1, 1) = "Subject" .Cells(1, 2) = "Received" .Cells(1, 3) = "Sender" End With intRow = 2 'Write messages to spreadsheet For Each olkMsg In Application.ActiveExplorer.CurrentFolder.Items 'Only export messages, not receipts or appointment requests, etc. If olkMsg.Class = olMail Then 'Add a row for each field in the message you want to export excWks.Cells(intRow, 1) = olkMsg.Subject excWks.Cells(intRow, 2) = olkMsg.ReceivedTime excWks.Cells(intRow, 3) = olkMsg.SenderName intRow = intRow + 1 End If Next Set olkMsg = Nothing excWkb.SaveAs strFilename excWkb.Close End If Set excWks = Nothing Set excWkb = Nothing Set excApp = Nothing MsgBox "Process complete. A total of " & intRow - 2 & " messages were exported.", vbInformation + vbOKOnly, "Export messages to Excel" End Sub Private Function GetSMTPAddress(Item As Outlook.MailItem, intOutlookVersion As Integer) As String Dim olkSnd As Outlook.AddressEntry, olkEnt As Object On Error Resume Next Select Case intOutlookVersion Case Is < 14 If Item.SenderEmailType = "EX" Then GetSMTPAddress = SMTP2007(Item) Else GetSMTPAddress = Item.SenderEmailAddress End If Case Else Set olkSnd = Item.Sender If olkSnd.AddressEntryUserType = olExchangeUserAddressEntry Then Set olkEnt = olkSnd.GetExchangeUser GetSMTPAddress = olkEnt.PrimarySmtpAddress Else GetSMTPAddress = Item.SenderEmailAddress End If End Select On Error GoTo 0 Set olkPrp = Nothing Set olkSnd = Nothing Set olkEnt = Nothing End Function Function GetOutlookVersion() As Integer Dim arrVer As Variant arrVer = Split(Outlook.Version, ".") GetOutlookVersion = arrVer(0) End Function Function SMTP2007(olkMsg As Outlook.MailItem) As String Dim olkPA As Outlook.PropertyAccessor On Error Resume Next Set olkPA = olkMsg.PropertyAccessor SMTP2007 = olkPA.GetProperty("http://schemas.microsoft.com/mapi/proptag/0x5D01001E") On Error GoTo 0 Set olkPA = Nothing End Function 

但是,当我打开下载的文件时,Excel表示文件格式和扩展名不匹配。

什么可能导致这个问题?

改变你的两行:

 excWkb.SaveAs strFilename excWkb.Close 

至:

 excWkb.SaveAs Filename:=strFilename, FileFormat:=xlCSV, CreateBackup:=False excWkb.Close SaveChanges:=False