我可以一次性给你完整的代码,但这无助于你从中学习;)所以让我们分解你的请求,然后我们将一个一个地处理它们。这将是一个很长的帖子,所以请耐心等待: )
共有 5 个部分将涵盖所有 7 个(是 7 个而不是 6 个)点,因此您不必为第 7 个点创建新问题。
第1部分
- 创建与 Outlook 的连接
- 检查是否有未读邮件
- 检索详细信息,例如
Sender email Address
, Date received
, Date Sent
, Subject
,The message of the email
请参阅此代码示例。我正在从 Excel 中使用 Outlook 进行后期绑定,然后检查是否有任何未读项目以及是否有我正在检索相关详细信息。
Const olFolderInbox As Integer = 6
Sub ExtractFirstUnreadEmailDetails()
Dim oOlAp As Object, oOlns As Object, oOlInb As Object
Dim oOlItm As Object
'~~> Outlook Variables for email
Dim eSender As String, dtRecvd As String, dtSent As String
Dim sSubj As String, sMsg As String
'~~> Get Outlook instance
Set oOlAp = GetObject(, "Outlook.application")
Set oOlns = oOlAp.GetNamespace("MAPI")
Set oOlInb = oOlns.GetDefaultFolder(olFolderInbox)
'~~> Check if there are any actual unread emails
If oOlInb.Items.Restrict("[UnRead] = True").Count = 0 Then
MsgBox "NO Unread Email In Inbox"
Exit Sub
End If
'~~> Store the relevant info in the variables
For Each oOlItm In oOlInb.Items.Restrict("[UnRead] = True")
eSender = oOlItm.SenderEmailAddress
dtRecvd = oOlItm.ReceivedTime
dtSent = oOlItm.CreationTime
sSubj = oOlItm.Subject
sMsg = oOlItm.Body
Exit For
Next
Debug.Print eSender
Debug.Print dtRecvd
Debug.Print dtSent
Debug.Print sSubj
Debug.Print sMsg
End Sub
这样就可以处理您的请求,该请求涉及在变量中存储详细信息。
第2部分
现在继续您的下一个请求
- 从我的 Outlook 收件箱中的第一封电子邮件(最新的电子邮件)下载唯一的附件
- 将附件保存在具有指定路径的文件中(例如:“C:...”)
- 将附件名称重命名为:当前日期 + 以前的文件名
请参阅此代码示例。我再次从 Excel 与 Outlook 进行后期绑定,然后检查是否有任何未读项目,如果有,我将进一步检查它是否有附件,然后将其下载到相关文件夹。
Const olFolderInbox As Integer = 6
'~~> Path for the attachment
Const AttachmentPath As String = "C:\"
Sub DownloadAttachmentFirstUnreadEmail()
Dim oOlAp As Object, oOlns As Object, oOlInb As Object
Dim oOlItm As Object, oOlAtch As Object
'~~> New File Name for the attachment
Dim NewFileName As String
NewFileName = AttachmentPath & Format(Date, "DD-MM-YYYY") & "-"
'~~> Get Outlook instance
Set oOlAp = GetObject(, "Outlook.application")
Set oOlns = oOlAp.GetNamespace("MAPI")
Set oOlInb = oOlns.GetDefaultFolder(olFolderInbox)
'~~> Check if there are any actual unread emails
If oOlInb.Items.Restrict("[UnRead] = True").Count = 0 Then
MsgBox "NO Unread Email In Inbox"
Exit Sub
End If
'~~> Extract the attachment from the 1st unread email
For Each oOlItm In oOlInb.Items.Restrict("[UnRead] = True")
'~~> Check if the email actually has an attachment
If oOlItm.Attachments.Count <> 0 Then
For Each oOlAtch In oOlItm.Attachments
'~~> Download the attachment
oOlAtch.SaveAsFile NewFileName & oOlAtch.Filename
Exit For
Next
Else
MsgBox "The First item doesn't have an attachment"
End If
Exit For
Next
End Sub
部分 - 3
继续您的下一个请求
- 将电子邮件保存到不同的文件夹中,路径为“C:...”
请参阅此代码示例。这保存电子邮件说 C:\
Const olFolderInbox As Integer = 6
'~~> Path + Filename of the email for saving
Const sEmail As String = "C:\ExportedEmail.msg"
Sub SaveFirstUnreadEmail()
Dim oOlAp As Object, oOlns As Object, oOlInb As Object
Dim oOlItm As Object, oOlAtch As Object
'~~> Get Outlook instance
Set oOlAp = GetObject(, "Outlook.application")
Set oOlns = oOlAp.GetNamespace("MAPI")
Set oOlInb = oOlns.GetDefaultFolder(olFolderInbox)
'~~> Check if there are any actual unread emails
If oOlInb.Items.Restrict("[UnRead] = True").Count = 0 Then
MsgBox "NO Unread Email In Inbox"
Exit Sub
End If
'~~> Save the 1st unread email
For Each oOlItm In oOlInb.Items.Restrict("[UnRead] = True")
oOlItm.SaveAs sEmail, 3
Exit For
Next
End Sub
部分 - 4
继续您的下一个请求
- 将 Outlook 中的电子邮件标记为“已读”
请参阅此代码示例。这会将电子邮件标记为read
。
Const olFolderInbox As Integer = 6
Sub MarkAsUnread()
Dim oOlAp As Object, oOlns As Object, oOlInb As Object
Dim oOlItm As Object, oOlAtch As Object
'~~> Get Outlook instance
Set oOlAp = GetObject(, "Outlook.application")
Set oOlns = oOlAp.GetNamespace("MAPI")
Set oOlInb = oOlns.GetDefaultFolder(olFolderInbox)
'~~> Check if there are any actual unread emails
If oOlInb.Items.Restrict("[UnRead] = True").Count = 0 Then
MsgBox "NO Unread Email In Inbox"
Exit Sub
End If
'~~> Mark 1st unread email as read
For Each oOlItm In oOlInb.Items.Restrict("[UnRead] = True")
oOlItm.UnRead = False
DoEvents
oOlItm.Save
Exit For
Next
End Sub
第 5 部分
继续您的下一个请求
- 在excel中打开excel附件
一旦您下载了如上所示的文件/附件,然后使用以下代码中的路径打开文件。
Sub OpenExcelFile()
Dim wb As Workbook
'~~> FilePath is the file that we earlier downloaded
Set wb = Workbooks.Open(FilePath)
End Sub
我将这篇文章转换为几篇博客文章(有更多解释),可以通过vba-excel中的第 15,16 和 17 点访问