使用VBA将电子邮件消息写入Outlook中的平面文件

Sub SaveEmailsToCSV()
    Dim objItem As Object
    Dim objMail As Outlook.MailItem
    Dim objFSO As Object
    Dim objFile As Object
    Dim strFolderPath As String
    Dim strFileName As String
    Dim strSubject As String
    Dim strFrom As String
    Dim strTo As String
    Dim strBody As String
    Dim strDate As String
    Dim strTime As String

    '设置文件夹路径
    strFolderPath = "C:\Emails\"

    '创建文件夹（如果不存在）
    Set objFSO = CreateObject("Scripting.FileSystemObject")
    If Not objFSO.FolderExists(strFolderPath) Then
        objFSO.CreateFolder strFolderPath
    End If

    '遍历Outlook收件箱中的所有电子邮件
    For Each objItem In Outlook.Application.Session.GetDefaultFolder(olFolderInbox).Items
        If objItem.Class = olMail Then
            Set objMail = objItem

            '获取邮件的主题、发件人、收件人、正文、日期和时间
            strSubject = objMail.Subject
            strFrom = objMail.SenderEmailAddress
            strTo = objMail.To
            strBody = objMail.Body
            strDate = objMail.ReceivedTime
            strTime = Format(objMail.ReceivedTime, "hh:mm:ss")

            '创建CSV文件名
            strFileName = strFolderPath & Format(strDate, "yyyy-mm-dd_") & strTime & ".csv"

            '打开文件并写入邮件信息
            Set objFile = objFSO.CreateTextFile(strFileName, True)
            objFile.WriteLine "Subject: " & strSubject
            objFile.WriteLine "From: " & strFrom
            objFile.WriteLine "To: " & strTo
            objFile.WriteLine "Body: " & strBody
            objFile.WriteLine "Date: " & strDate
            objFile.WriteLine "Time: " & strTime
            objFile.Close
        End If
    Next

    MsgBox "电子邮件已保存到CSV文件中！"
End Sub