从outlook收到的电子邮件日期。格式问题和从单元格中的信息搜索

时间:2015-04-14 08:50:24

标签: excel vba email excel-vba outlook

Sub ReceivedEmailDate()
Dim outlookApp
Dim olNs As Outlook.Namespace
Dim Fldr As Outlook.MAPIFolder
Dim olMail As Variant
Dim myTasks
Dim sir() As String

Set outlookApp = CreateObject("Outlook.Application")

Set olNs = outlookApp.GetNamespace("MAPI")
Set Fldr = olNs.GetDefaultFolder(olFolderInbox)
Set myTasks = Fldr.Items

i = 2             'This is the row you want the date/time to start from

For Each olMail In myTasks

                'This is where the search occurs in the outlook inbox (parameters can be altered depending on what you want to search for)
                'I have stated to search for the invoice numbers in the subject field of the email. Invoice numbers located down column E
If (InStr(1, olMail.Subject, ActiveSheet.Cells(i, 5), vbTextCompare) > 0) Then
  ActiveSheet.Cells(i, 8).Value = Format(olMail.ReceivedTime, "DD/MM/YY")      'format function to only show the date, rather than both date and time


  i = i + 1     'Count so that each email date/time is entered in the row below the previous one

End If

Next olMail

Set Fldr = Nothing
Set olNs = Nothing
Set olApp = Nothing

End Sub

我希望代码在outlook中搜索单元格E2中的内容并在单元格H2中发布接收日期,然后在outlook中搜索单元格E3中的内容并在单元格H3中发布接收日期等等上。

我以为我已经工作了一段时间,但它现在只在第一个单元格中发布(H2)。此外,格式似乎到处都是。

非常感谢任何帮助。

1 个答案:

答案 0 :(得分:1)

没有循环来遍历E列中的值。另一个涉及 i For ... Next循环应该足够了。

Sub ReceivedEmailDate()
    Dim outlookApp
    Dim olNs As Outlook.Namespace
    Dim Fldr As Outlook.MAPIFolder
    Dim olMail As Variant
    Dim myTasks
    Dim sir() As String

    Set outlookApp = CreateObject("Outlook.Application")

    Set olNs = outlookApp.GetNamespace("MAPI")
    Set Fldr = olNs.GetDefaultFolder(olFolderInbox)
    Set myTasks = Fldr.Items

    With ActiveSheet
        For i = 2 To .Cells(Rows.Count, "E").End(xlUp).Row
            For Each olMail In myTasks

                'This is where the search occurs in the outlook inbox (parameters can be altered depending on what you want to search for)
                'I have stated to search for the invoice numbers in the subject field of the email. Invoice numbers located down column E
                If CBool(InStr(1, olMail.Subject, .Cells(i, "E").Value, vbTextCompare)) Then
                    .Cells(i, "H") = CDate(olMail.ReceivedTime)   'put a real datetime in whether you need it right now or not
                    .Cells(i, "H").NumberFormat = "dd/mm/yy"      'format function to only show the date, rather than both date and time
                End If

            Next olMail
        Next i
    End With

    Set myTasks = Nothing
    Set Fldr = Nothing
    Set olNs = Nothing
    Set outlookApp = Nothing

End Sub

我已将实际日期时间放入H列并将其格式化为 dd / mm / yy 。如果您愿意,可以恢复为日期的文本表示。