Question

我有一本excel工作簿，用于循环浏览文件夹中的一堆.msg文件，以提取“发送”，“发件人”和“主题”字段。我可以提取信息，但是只能通过明确引用文件名（在本例中为test和test2）。如何遍历目录中的所有.msg文件并提取相关信息？这是我到目前为止的内容：

UINTMAX_C()

Answer 1

这将循环遍历.msg文件目录中的每个文件尚未使用OpenSharedItem，因此您可能需要直接＆“ \”和myfile来代替myfile。我不建议使用ActiveWorkbook.Path，但也许您没有其他方法，例如要求用户在FolderPicker中选择文件夹？

direct = ActiveWorkbook.Path
myfile = Dir(direct, "*.msg")  'sets myfile equal to the first file name
Do While myfile <> ""        'loops until there are no more files in the directory
        Set mailDoc = olApp.Session.OpenSharedItem(myfile)
        Sheets("sheet1").Range("a1").Offset(i) = mailDoc.SentOn
        Sheets("sheet1").Range("a1").Offset(i, 1) = mailDoc.Sender
        Sheets("sheet1").Range("a1").Offset(i, 2) = mailDoc.Subject
        mailDoc.Close False
        i = i + 1

     myfile = Dir            

Loop

Answer 2

您可以使用Dir函数进行此操作。 here是一个使用示例。对于您的情况，这是正确的代码：

Option Explicit

Sub getMsgData()


    Dim olApp As Outlook.Application
    Set olApp = CreateObject("Outlook.Application")

    Dim mailDoc As Outlook.MailItem
    Dim i As Long
    i = 1

    Dim nam As String
    nam = Dir(ActiveWorkbook.Path & "\*.msg")
    Do While nam <> ""
        Set mailDoc = olApp.Session.OpenSharedItem(ActiveWorkbook.Path & "\" & nam)
        Sheets("sheet1").Range("a1").Offset(i) = mailDoc.SentOn
        Sheets("sheet1").Range("a1").Offset(i, 1) = mailDoc.Sender
        Sheets("sheet1").Range("a1").Offset(i, 2) = mailDoc.Subject
        mailDoc.Close False
        i = i + 1
        nam = Dir
    Loop

    olApp.Quit

    Set mailDoc = Nothing
    Set olApp = Nothing

End Sub

Excel VBA：遍历.msg文件目录

2 个答案: