Question

我经常使用Stack Overflow，但这是我的第一篇文章。我知道VBA足够危险。

我最初为Outlook编写了这段代码 - 它的最初目的是重命名任何附件文件并将其保存在特定目录中（对于向我发送文件的人，我仍然需要该功能，如下所示为email @ email。 COM）。

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

显然我的方法不起作用，我找不到类似于我在Stack Overflow上尝试做的任何情况。有人愿意帮我解决这个问题吗？非常感谢大家的帮助！

这就是我现在所拥有的，但我的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

在David的修改/建议之后，代码如下所示：

你好@DavidZemens！非常感谢你仔细考虑过的答案并指出了问题;你的方法对我很有意义。我已经根据您的建议重新配置了代码，并且我收到了“运行时错误91 - 对象变量或未设置块变量”错误，该错误突出显示了我的“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

在最近的建议之后，这是带有新错误的新代码

当新电子邮件进来时，它给我的错误是数组超出界限并突出显示的行：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

Answer 1

这是一个错误：

Workbooks.Open (objAtt)

因为Open方法需要字符串文件路径，而不是Outlook.Attachment对象。

另外，因为我没有看到对Excel对象模型的任何早期绑定引用，所以您可能会发现编译错误：未定义的用户定义类型 Workbooks.Open行。您需要创建一个对象来保存Excel Application：

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

此外，您的变量CSV未声明，也未分配任何值，因此如果您获得要编译的代码，很可能会引发另一个错误。

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

注意：在代码模块顶部使用Option Explicit将阻止您使用未声明的变量，未列举的常量，变量名称中的拼写错误等编写hacky代码。

由于您无法在附件上使用Workbooks.Open，首先，您希望将附件保存到磁盘，然后使用Excel来打开保存的文件（从磁盘），然后您可以使用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

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

1 个答案: