将Outlook附件中的所有Excel工作簿保存到另一个位置

Question

我正在开发一个excel vba宏，它应该只将excel文件从outlook复制到另一个位置

我有以下代码

Sub Test(itm As Outlook.MailItem)
Dim objAtt As Outlook.Attachment
    Dim saveFolder As String
        saveFolder = "C:\APIndex"
    Dim dateFormat As String
        dateFormat = Format(itm.ReceivedTime, "yyyy-mm-dd Hmm ")
    For Each objAtt In itm.Attachments
        objAtt.SaveAsFile saveFolder & "\" & dateFormat & objAtt.DisplayName
    Next
End Sub

使用上面的代码，我能够下载所有文件，包括一些图像和pdf，但我只想要.xls和.xlsx文件。

有什么方法可以做到这一点吗？

Answer 1

您可以使用例如VBA InStr()来实现某种预过滤，以检查文件名是否包含。xls或。 xlsx，如下面的代码段所示：

if (InStr(1, FileName, ".xls") >0 Or InStr(1, FileName, ".xlsx") >0) Then
'Save the File
End If

希望这会有所帮助。