Загрузите вложения .csv от Today - PullRequest
1 голос
/ 23 апреля 2019

Я хочу скачать 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 голосов
/ 25 апреля 2019

Я смог ответить на свой вопрос. Ниже мой модифицированный код.

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


Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...