VBA-Excel и перспективы;Как получить список рассылки, полученный на конкретную дату, и сохранить на нем прикрепленные файлы - PullRequest
0 голосов
/ 23 апреля 2019
  1. В Excel я хотел бы создать папку с именем сегодняшней даты при нажатии кнопки
  2. Затем, Получение полученных писем в определенный день, чтобы получить вложения в письме
  3. Переименуйте вложенные файлы. В моем листе Excel есть некоторая информация, такая как doc_num, doc_name и receive_date. Если вложенное имя файла равно doc_name, переименуйте вложенный файл в doc_num_doc_name_received_date.

Это то, что я хотел бы сделать.

Я получил исходные коды somw, поэтому процедура 1 выполнена. Однако я не могу сделать процедуру 2.

Public Sub SaveAttachment(FPath As String, UserDate As Date)
    Dim OutlookApp As Object 'Object 생성
    Dim ONameSpace As Object
    Dim OutlookMail As Object 'GetItems
    Set OutlookApp = CreateObject("Outlook.Application")
    Set ONameSpace = OutlookApp.GetNamespace("MAPI")
    Set OutlookMail = OutlookApp.CreateItem(0)
    Dim Atmt As Attachment
    Dim FileName As String
    Dim TimeCrit    As Date
    Dim OItems As Outlook.Items
    Dim OInbox As Outlook.Items
    TimeCrit = UserDate
    Set OInbox = ONameSpace.GetDefaultFolder(olFolderInbox).Items
    Set OItems = OInbox.Restrict("[ReceivedTime] >= """ & Format(TimeCrit, "yyyy-mm-dd") & """")
    Dim MailItem As Object
    Dim OItem As Object
    Dim Found As Boolean
    Found = False
    For Each OItem In OItems
        Debug.Print "6."; OItem.Subject
            Dim dRT As Date
            'dRT = olMail.ReceivedTime
            dRT = OItem.ReceivedTime
        For Each Atmt In OItem.Attachments
            Debug.Print "dRT : "; dRT
            FileName = FPath & "\" & Format(dRT, "yyyy-mm-dd") & "-" & Atmt.FileName
            Atmt.SaveAsFile FileName
            i = i + 1
        Next Atmt
    Next OItem
    Set OutlookApp = Nothing
End Sub

Sub MakeNewDirectory()
    Dim Username As String
    Dim pathName As String
    Dim FPath As String
    Dim dif As Integer
    Dim UserDt As Date
    Username = InputBox("ID number", "Input your ID number", "qxxxxxx")
    UserDt = InputBox("Date", "This is the date you want to search", "yyyy-mm-dd")
    pathName = "C:\Users\" & Username & "\Downloads\"
    today = Format(Now, "yyyy-mm-dd")
    FPath = pathName & today & "-" & Username
    If Len(Dir(FPath, vbDirectory)) = 0 Then MkDir FPath
    dif = DateDiff("d", UserDt, today)
    Call SaveAttachment(FPath, UserDt)
    Call openExcel(pathName)
End Sub
Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...