从今天开始下载.csv附件

时间:2019-04-23 19:24:38

标签: vba outlook outlook-vba

我想下载每天收到的4个独特的csv文件。所以我需要自动下载这4个。截至目前,我可以下载所有csv文件,但不能将其仅限于今天。

这是我当前的代码。

Public Sub SaveAutoAttach(item As Outlook.MailItem)

Dim object_attachment As Outlook.Attachment

Dim saveFolder As String

saveFolder = "C:\Desktop\Automatic Outlook Downloads"
For Each object_attachment In item.Attachments


If InStr(object_attachment.DisplayName, ".csv") Then
'If Int(object_attachment.ReceivedTime) = Date Then
    object_attachment.SaveAsFile saveFolder & "\" & object_attachment.DisplayName

End If
'End If

Next


End Sub

1 个答案:

答案 0 :(得分:0)

我能够回答自己的问题。下面是我修改的代码。

Public Sub SaveAutoAttach(item As Outlook.MailItem)
Dim olApp As Object
Dim olNS As Object
Dim myDate As Date
Dim olItems As Object
Dim olItem As Object
Dim olAttach As Object

On Error Resume Next
Set olApp = GetObject(, "Outlook.Application")
Err.Clear: On Error GoTo 0

If olApp Is Nothing Then
Set olApp = CreateObject("Outlook.Application")
Flg = True
End If

Set olNS = olApp.GetNamespace("MAPI")

Set olItems = olNS.GetDefaultFolder(olFolderInbox).Items

For Each olItem In olItems
    If olItem.ReceivedTime > Date Then
    On Error GoTo Finished
    Set olAttach = olItem.Attachments.item(1)
    Err.Clear: On Error GoTo 0
    If Not olAttach Is Nothing Then
    If olAttach.FileName Like "*.csv" Then

    On Error GoTo Finished
    olAttach.SaveAsFile "C:\Desktop\Automatic Outlook Downloads" & "\" & olAttach.FileName
    Set olAttach = Nothing
    Set olItem = Nothing
    End If
    End If
    End If
Next