VBAを使用してOutlookのフラットファイルに電子メールメッセージを書き込む
-
03-07-2019 - |
質問
Outlookでフォルダーを開き、メッセージを反復処理するVBAアプリを作成しました。メッセージ本文を(多少の調整を加えて)単一のフラットファイルに書き込む必要があります。私のコードは次のとおりです...
Private Sub btnGo_Click()
Dim objOutlook As New Outlook.Application
Dim objNameSpace As Outlook.NameSpace
Dim objInbox As MAPIFolder
Dim objMail As mailItem
Dim count As Integer
Set objNameSpace = objOutlook.GetNamespace("MAPI")
Set objInbox = objNameSpace.GetDefaultFolder(olFolderInbox)
count = 0
For Each objMail In objInbox.Items
lblStatus.Caption = "Count: " + CStr(count)
ProcessMailItem (objMail)
count = count + 1
Next objMail
End If
End Sub
問題の部分は" ProcessMailItem"です。私はこの段階でのパフォーマンスにあまり関心がないので、非常に非効率な「オープン、アペンド、クローズ」;この例では、ファイルの方法論は問題ありません。
グーグルで答えを調べるのに少し時間を費やすことができることは知っていますが、最初にここでチェックしましたが、これに対する良い答えはありませんでした。 Stackoverflowのファンであることをここに掲載することで、将来の開発者が答えを探してくれることを願っています。しばらくお待ちください。
解決
組み込みのVBAファイルツールを使用するだけで、オブジェクトを使用せずにファイルに書き込むことができます。
Open "C:\file.txt" for append as 1
Print #1, SomeStringVar
Close #1
他のヒント
テキストを追加するたびに出力ファイルを再度開くことを気にしない場合、これは動作するはずです。
Private Sub ProcessMailItem(objMail As MailItem)
Dim fso As New FileSystemObject
Dim ts As TextStream
Set ts = fso.OpenTextFile("C:\Outputfile.txt", ForAppending, True)
ts.Write(objMail.Body)
ts.Close()
Set ts = Nothing
Set fso = Nothing
End Sub
Microsoft Scripting Runtimeライブラリへの参照も追加する必要があります。これにはFileSystemObjectが含まれています。
また、セキュリティポップアップ「電子メールアドレスへのアクセスの試行」にも注意する必要があります。 Outlook" Object Model Guard"で説明されています。開発者向けのセキュリティ問題
Public Sub ProcessMailItem(objMail As MailItem)
Dim FSO As New FileSystemObject
Dim ts As TextStream
Dim loc As String
Dim subject As String
Dim strID As String
' per http://www.outlookcode.com/article.aspx?ID=52
Dim olNS As Outlook.NameSpace
Dim oMail As Outlook.MailItem
strID = MyMail.EntryID
Set olNS = Application.GetNamespace("MAPI")
Set oMail = olNS.GetItemFromID(strID)
subject = oMail.subject
Set ts = FSO.OpenTextFile("C:\Documents and Settings\tempuser\My Documents\EMAILS\" + subject, ForAppending, True)
ts.Write (oMail.Body)
ts.Close
Set ts = Nothing
Set FSO = Nothing
Set oMail = Nothing
Set olNS = Nothing
サブの終了
所属していません StackOverflow