打开文件从Outlook到Excel并保存为不同的格式,具体取决于发件人

我使用堆栈溢出很多,但这是我的第一篇文章。 我知道VBA就足够危险了。

我最初为Outlook编写了这段代码 – 它的最初目的是重命名任何附件文件并将其保存在特定的目录中(我仍然需要发送给我的文件的一个人的function,如email@email.com)。

现在我有多个人发送文件,需要修改脚本以确定文件的发件人是谁(我知道一个发件人总是将附件作为Excel XLSX文件发送,但我需要它作为CSV)打开XLSX文件在Excel中并将其保存为纯CSV。

很明显,我的方法不起作用,我找不到任何类似于我想要堆栈溢出的情况。 有人愿意帮我解决这个问题吗? 非常感谢大家的帮助!

这是我现在的,但我的If语句似乎没有工作…

Public Sub saveAttachtoDisk(itm As Outlook.MailItem) Dim objAtt As Outlook.Attachment Dim saveFolder As String Dim saveFolder2 As String Dim dateFormat dateFormat = Format(Now, "yyyy-mm-dd H-mm") saveFolder = "c:temp1" saveFolder2 = "c:\temp2" ' CASE 1 If objAtt.SenderName = "Sender's First & Last Name" Then For Each objAtt In itm.Attachments ' open excel Workbooks.Open (objAtt) ' save as csv to queue directory for upload to FTP site ActiveWorkbook.SaveAs FileName:=saveFolder2 & "\" & dateFormat & ".csv",FileFormat:=CSV, CreateBackup:=False ActiveWorkbook.Saved = True ActiveWindow.Close Set objAtt = Nothing End If ' CASE 2 If objAtt.SenderName = "email@email.com" Then For Each objAtt In itm.Attachments objAtt.SaveAsFile saveFolder & "\" & dateFormat & "FC.csv" Set objAtt = Nothing Next End If End Sub 

大卫的修改/build议后,代码如下所示:

Hi @DavidZemens! 非常感谢你的深思熟虑的答复和指出问题; 你的方法对我很有意义。 我用你的build议重新configuration了代码,我得到了“运行时错误91 – 对象variables或块variables未设置”的错误,突出了我的“If”语句的第一行。 你能确定我可能做错了,得到这个错误?

 Option Explicit Public Sub saveAttachtoDisk(itm As Outlook.MailItem) Dim objAtt As Outlook.Attachment Dim saveFolder As String Dim saveFolder2 As String Dim dateFormat Const xlCSV As Long = 6 Dim xlsxPath As String Dim wb As Object Dim oExcel As Object Set oExcel = CreateObject("Excel.Application") dateFormat = Format(Now, "yyyy-mm-dd H-mm") saveFolder = "c:\temp1" saveFolder2 = "c:\temp2" 'CASE 1 If objAtt.SenderName = "John Smith" Then xlsxPath = saveFolder2 & "\" & dateFormat & ".xlsx" objAtt.SaveAsFile xlsxPath ' use excel to open and save the file as csv Set wb = oExcel.Workbooks.Open(xlsxPath) wb.SaveAs FileName:=Replace(xlsxPath, ".xlsx", ".csv"), FileFormat:=xlCSV wb.Close oExcel.Quit End If 'CASE 2 If objAtt.SenderName = "email@email.com" Then For Each objAtt In itm.Attachments objAtt.SaveAsFile saveFolder & "\" & dateFormat & ".csv" Set objAtt = Nothing Next End If End Sub 

在最近的build议之后,这是新的错误代码

当新的电子邮件进来时,它给我的错误是该数组超出了界限,并突出显示该行:Set objAtt = itm.Attachments(0)

 Public Sub saveAttachtoDisk(itm As Outlook.MailItem) Dim objAtt As Outlook.Attachment Dim saveFolder As String Dim saveFolder2 As String Dim dateFormat Const xlCSV As Long = 6 Dim xlsxPath As String Dim wb As Object Dim oExcel As Object Set oExcel = CreateObject("Excel.Application") dateFormat = Format(Now, "yyyy-mm-dd H-mm") saveFolder = "c:\temp1" saveFolder2 = "c:\temp2" xlsxPath = saveFolder2 & "\" & dateFormat & ".xlsx" **'Case 1** If itm.SenderName = "John Smith" Then If itm.Attachments.Count > 0 Then <-- note: I had this as <> and had same error Set objAtt = itm.Attachments(0) Else: GoTo EarlyExit End If End If objAtt.SaveAsFile xlsxPath '## Use excel to open and save the file: Set wb = oExcel.Workbooks.Open(xlsxPath) wb.SaveAs FileName:=Replace(xlsxPath, ".xlsx", ".csv"), FileFormat:=xlCSV wb.Close '## Get rid of the XLSX version if it's no longer needed On Error Resume Next Kill xlsxPath On Error GoTo 0 EarlyExit: oExcel.Quit **' Case 2** If itm.SenderEmailAddress = "email@email.com" Then For Each objAtt In itm.Attachments objAtt.SaveAsFile saveFolder & "\" & dateFormat & "FranklinCounty.csv" Set objAtt = Nothing Next End If 

这是一个错误:

Workbooks.Open (objAtt)

因为Open方法需要一个string文件path,而不是Outlook.Attachment对象。

另外,因为我没有看到任何对Excel对象模型的早期绑定引用,所以您可能会遇到编译错误: 用户定义的types没有Workbooks.Open行上定义 。 您需要创build一个对象来保存Excel应用程序:

 Dim oExcel as Object Set oExcel = CreateObject("Excel.Application") 

此外,你的variablesCSV没有被声明,也没有赋值,所以如果你得到编译的代码,很可能会引发另一个错误。

 '## Require explicit declaration of Excel constants, unless you're using early-binding Const xlCSV as Long = 6 

注意 :在你的代码模块的顶部使用Option Explicit将会阻止你用未声明的variables,未列举的常量,variables名中的拼写错误等来编写hacky代码。

由于无法使用Workbooks.Open 附件 ,因此首先要将附件保存到磁盘,然后使用Excel 打开保存的文件(从磁盘),然后可以使用SaveAs将其SaveAs为不同的格式。 这将导致重复的文件(一个XLSX和一个CSV),您可以在不想保留的那个上使用Kill语句。

 Dim xlsxPath As String Dim wb as Object 'Excel.Workbook xlsxPath = saveFolder2 & "\" & dateFormat & ".xlsx" '## This assumes the file will always be XLSX format '## get a handle on your mail item: If itm.Attachments.Count <> 0 Then Set objAtt = itm.Attachments(1) Else: Goto EarlyExit End If objAtt.SaveAsFile xlsxPath '## use Excel to open and save the file: Set wb = oExcel.Workbooks.Open(xlsxPath) wb.SaveAs FileName:=Replace(xlsxPath, ".xlsx", ".csv"), FileFormat:=xlCSV wb.Close '## Get rid of the XLSX version if it's no longer needed On Error Resume Next Kill xlsxPath On Error GoTo 0 

然后,在您的End Sub之前退出Excel:

 EarlyExit: oExcel.Quit() End Sub