0

膨大な数の Outlook .msg および Outlook .eml ファイルが共有ネットワーク フォルダ (つまり、Outlook の外部) に保存されています。各ファイルから件名、送信者、CC、受信者、SentTime、SentDate、メッセージ本文テキストを抽出し、これらの情報を Excel セルに順番にインポートする VBA を Excel で作成しようとしています。

件名 送信者 CC 受信者 SentTime SentDate

Re:.. マイク・ジェーン・トム 12:00:00 23 Jan 2013

Word ドキュメントでも同様のことを行いましたが、.msg ファイル内のテキストを「取得」するのに苦労しています。

これまでのところ、以下のコードがあります。少なくとも正しい軌道に乗っていると思いたいのですが、msg ファイルへの参照を設定しようとしている行で行き詰っています。アドバイスをいただければ幸いです...

Dim MyOutlook As Outlook.Application
Dim MyMail As Outlook.MailItem

Set MyOutlook = New Outlook.Application


Set MyMail = 

Dim FileContents As String

FileContents = MyMail.Body

よろしく

4

3 に答える 3

3

そのため、Outlook 以外に保存された .msg ファイルで動作させることができました。ただし、Outlook Express にアクセスできないため、現時点では .eml ファイルを保存する方法がありません。これは、Subject、Sender、CC、To、SendOn を Excel ワークシートの行 2 列 1 から挿入する、私が思いついたサブです (行 1 のヘッダー行を想定):

Sub GetMailInfo(Path As String)

    Dim MyOutlook As Outlook.Application
    Dim msg As Outlook.MailItem
    Dim x As Namespace

    Set MyOutlook = New Outlook.Application
    Set x = MyOutlook.GetNamespace("MAPI")

    FileList = GetFileList(Path + "*.msg")


    row = 1

    While row <= UBound(FileList)

        Set msg = x.OpenSharedItem(Path + FileList(row))

        Cells(row + 1, 1) = msg.Subject
        Cells(row + 1, 2) = msg.Sender
        Cells(row + 1, 3) = msg.CC
        Cells(row + 1, 4) = msg.To
        Cells(row + 1, 5) = msg.SentOn


        row = row + 1
    Wend

End Sub

以下で定義されているように GetFileList 関数を使用します (スプレッドシートページ.com に感謝)

Function GetFileList(FileSpec As String) As Variant
'   Taken from http://spreadsheetpage.com/index.php/tip/getting_a_list_of_file_names_using_vba/
'   Returns an array of filenames that match FileSpec
'   If no matching files are found, it returns False

    Dim FileArray() As Variant
    Dim FileCount As Integer
    Dim FileName As String

    On Error GoTo NoFilesFound

    FileCount = 0
    FileName = Dir(FileSpec)
    If FileName = "" Then GoTo NoFilesFound

'   Loop until no more matching files are found
    Do While FileName <> ""
        FileCount = FileCount + 1
        ReDim Preserve FileArray(1 To FileCount)
        FileArray(FileCount) = FileName
        FileName = Dir()
    Loop
    GetFileList = FileArray
    Exit Function

'   Error handler
    NoFilesFound:
        GetFileList = False
End Function

これ以上の説明が必要な場合はお知らせください。

編集: Outlook ライブラリへの参照も追加する必要があります

チッ！

Z

于 2013-04-23T15:54:45.997 に答える
0

.msg の完全なファイル名とパスを知っているか、計算できると仮定します。

Dim fName as String
fName = "C:\example email.msg"

Set MyMail = MyOutlook.CreateItemFromTemplate(fName)`
于 2013-04-18T04:27:26.703 に答える