- В Excel я хотел бы создать папку с именем сегодняшней даты при нажатии кнопки
- Затем, Получение полученных писем в определенный день, чтобы получить вложения в письме
- Переименуйте вложенные файлы.
В моем листе 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