Outlook電子メールをExcelにエクスポートする

Question

こんにちは！私はVBの初心者です。私はOutlookからのメールを、オンラインで入手できるいくつかのVBスクリプトの助けを借りて自動的にExcelにエクスポートしようとしています。私は80％の結果で終わった。私が使用したコードを見てください。その中で、私はメール本体もエクスポートするいくつかのコードを追加する必要があります。誰かが私を導いてください。

Public WithEvents objMails As Outlook.Items 


Private Sub Application_Startup() 

    Set objMails = Outlook.Application.Session.GetDefaultFolder(olFolderInbox).Items 

End Sub 



Private Sub objMails_ItemAdd(ByVal Item As Object) 

    Dim objMail As Outlook.MailItem 

    Dim strExcelFile As String 

    Dim objExcelApp As Excel.Application 

    Dim objExcelWorkBook As Excel.Workbook 

    Dim objExcelWorkSheet As Excel.Worksheet 

    Dim nNextEmptyRow As Integer 

    Dim strColumnB As String 

    Dim strColumnC As String 

    Dim strColumnD As String 

    Dim strColumnE As String 

    If Item.Class = olMail Then 
     Set objMail = Item 
    End If 


    strExcelFile = "d:\LocalData\Z018439\Desktop\MY\NX-AMO\Mail Export\export.xlsx" 


    On Error Resume Next 
    Set objExcelApp = GetObject(, "Excel.Application") 
    If Error <> 0 Then 
     Set objExcelApp = CreateObject("Excel.Application") 
    End If 
    Set objExcelWorkBook = objExcelApp.Workbooks.Open(strExcelFile) 
    Set objExcelWorkSheet = objExcelWorkBook.Sheets("Sheet1") 


    nNextEmptyRow = objExcelWorkSheet.Range("B" & objExcelWorkSheet.Rows.Count).End(xlUp).Row + 1 

    strColumnB = objMail.SenderName 
    strColumnC = objMail.SenderEmailAddress 
    strColumnD = objMail.Subject 
    strColumnE = objMail.ReceivedTime 


    If StrComp(strColumnB, "service_manager7@mail.nissan.co.jp", vbTextCompare) = 0 Then 

    objExcelWorkSheet.Range("A" & nNextEmptyRow) = nNextEmptyRow - 1 
    objExcelWorkSheet.Range("B" & nNextEmptyRow) = strColumnB 
    objExcelWorkSheet.Range("C" & nNextEmptyRow) = strColumnC 
    objExcelWorkSheet.Range("D" & nNextEmptyRow) = strColumnD 
    objExcelWorkSheet.Range("E" & nNextEmptyRow) = strColumnE 


    objExcelWorkSheet.Columns("A:E").AutoFit 


    objExcelWorkBook.Close SaveChanges:=True 


    End If 

    objExcelApp.Quit 


    Set objExcelApp = Nothing 


Set objExcelWorkBook = Nothing 



    Set objExcelWorkSheet = Nothing 



    Set objMail = Nothing 

End Sub 

Answer 1

ボディはあなたの思う通りです。

strColumnF = objMail.Body 

あなたも持っている、（htmlタグと体が表示されます）objMail.HTMLBodyCreationTime、FlagStatus、Recipients（受信者のコレクションは、文字列に変換する必要があるだろう）、そしてより多くの。デバッグモードで、式のすべての属性の完全なリストを表示するには、表示>ローカルウィンドウをチェックします。

Answer 2

objMail.commentsまたはobjMail.bodyのオプションが必要です。それを別の列にエクスポートできますか？

Answer 3

これを試してください。

Sub Import_Outlook_to_Excel() 
    Dim oitem As Outlook.MailItem 
    Dim i As Long 
    Sub all_folder_scan() 
    'Tools Reference Microsoft Outlook 
    Dim olapp As Outlook.Application 
    Dim olappns As Outlook.Namespace 
    Dim oinbox As Outlook.Folder 
    Dim oFolder As Outlook.MAPIFolder 
    i = 2 
    'tools->refrence->microsoft outlook 
    Set olapp = New Outlook.Application 
    Set olappns = olapp.GetNamespace("MAPI") 
    ' set inbox folder 
    Set oinbox = olappns.GetDefaultFolder(olFolderInbox) 
     'For Each oitem In oinbox.Items.Restrict("[UnRead] = True") 
      Sheets("All Folders Scan").Cells(i, 5).Value = oitem.Subject 
      Sheets("All Folders Scan").Cells(i, 4).Value = oitem.SenderEmailAddress 
      Sheets("All Folders Scan").Cells(i, 3).Value = oitem.SenderName 
      Sheets("All Folders Scan").Cells(i, 6).Value = oitem.Body 
      Sheets("All Folders Scan").Cells(i, 7).Value = oitem.ReceivedTime 
      Sheets("All Folders Scan").Cells(i, 2).Value = oinbox.Name 
      Sheets("All Folders Scan").Cells(i, 1).Value = oinbox.FolderPath 
      i = i + 1 
     'Next 
     For Each oFolder In oinbox.Folders 
      Call subfolders_go(oFolder) 
     Next 
    End Sub 

    Private Sub subfolders_go(oParent As Outlook.Folder) 
    Dim oFolder1 As Outlook.MAPIFolder 
     For Each oitem In oParent.Items.Restrict("[UnRead] = True") 
      Sheets("All Folders Scan").Cells(i, 5).Value = oitem.Subject 
      Sheets("All Folders Scan").Cells(i, 4).Value = oitem.SenderEmailAddress 
      Sheets("All Folders Scan").Cells(i, 3).Value = oitem.SenderName 
      Sheets("All Folders Scan").Cells(i, 6).Value = oitem.Body 
      Sheets("All Folders Scan").Cells(i, 7).Value = oitem.ReceivedTime 
      Sheets("All Folders Scan").Cells(i, 2).Value = oParent.Name 
      Sheets("All Folders Scan").Cells(i, 1).Value = oParent.FolderPath 
      i = i + 1 
     Next 
     If (oParent.Folders.Count > 0) Then 
      For Each oFolder1 In oParent.Folders 
       Call subfolders_go(oFolder1) 
      Next 
     End If 
    End Sub