Question

我写过这个宏。我想删除每封电子邮件的主题详细信息并将其显示在工作表中。代码目前遍历所有电子邮件及其主题，但我在尝试在csv或工作表中显示时遇到问题。在这段代码中，我已将显示注释到工作表。我两方面都遇到了问题。

Sub subdetails()
    Dim ns As Outlook.Namespace
    Dim Inbox As MAPIFolder
    Dim Item As Object
    Dim Atmt As Attachment
    Dim FileName As String
    Dim i As Integer
    Dim myolApp As Outlook.Application

Set myolApp = CreateObject("Outlook.Application")
Set ns = myolApp.GetNamespace("MAPI")
Set Inbox = ns.Folders("UA Forms")            '   GetDefaultFolder(olFolderInbox)
Set Inbox = Inbox.Folders("Inbox")

    i = 0
    If Inbox.Items.Count = 0 Then
        MsgBox "There are no messages in the Inbox", vbInformation, _
        "Nothing Found"
    Exit Sub

    End If
'''Section experiecing the problem'''
    For Each Item In Inbox.Items
    'Dim My_filenumber As Integer
    'Dim logSTR As String
    iCol = 1
    iRow = 3
   ' My_filenumber = FreeFile

    'logSTR = Item

    'Open "\\Dfs52672.link2\My Documents\ExcelTutorials\authors.csv" For Append As #My_filenumber
        'Print #My_filenumber, logSTR
    'Close #My_filenumber

    'i = i + 1
    'MsgBox "Your record has been logged"
    'Cells(iRow, iCol).Value = Item
    Columns(6).Value = Item
    i = i + 1
    MsgBox "I Found" & i & "attached files."
    Next Item

GetAttachments_exit:

        Set Atmt = Nothing
        Set Item = Nothing
        Set ns = Nothing
        Exit Sub

GetAttachment_err:

    MsgBox "An error has occurred." _
    & vbCrLf & "Please note and report the following information." _
    & vbCrLf & "Macro Name: GetAttachments" _
    & vbCrLf & "Error Number: " & Err.Number _
    & vbCrLf & "Error Description: " & Err.Description _
    , vbCritical, "Error!"

    Resume GetAttachments_exit
End Sub

Answer 1

要在Excel（Col A）中列出收件箱中的电子邮件主题，请尝试将循环更改为：

iRow = 3

For Each Item In Inbox.Items
    Cells(iRow, 1).Value = Item.Subject

    iRow = iRow + 1
Next Item

这假设您有一个打开的工作簿并且已经引用了。如果没有，您应该添加以下内容：

Dim wbNew As Workbook
Set wbNew = Workbooks.Add

Dim wksNew As Worksheet
Set wksNew = wbNew.Worksheets("Sheet1")

iRow = 3

For Each Item In Inbox.Items
    wksNew.Cells(iRow, 1).Value = Item.Subject

    iRow = iRow + 1
Next Item

宏取出主题细节

1 个答案: