Outlook 전자 메일을 Excel로 내보내기

Question

안녕하세요! 나는 VB에 익숙하지 않다. 온라인에서 사용할 수있는 일부 VB 스크립트의 도움을 받아 Outlook에서 메일을 자동으로 내보내려고합니다. 나는 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