复制电子邮件主题在Outlook中使用vba与两个电子邮件地址excel？ [英] Copy email subject in outlook to excel using vba with two email address?

问题描述

我有两个电子邮件地址。第一个是 [e-mail] ，第二个是 [e-mail] 。

我想在微软展望中复制电子邮件主题，第二个地址是 [e-mail] VBA。我使用bellow代码，但它不起作用。

  Sub GetFromInbox（）
 Dim olapp作为Outlook.Application 
 Dim olNs As Namespace 
 Dim Fldr As MAPIFolder 
 Dim olMail As Variant 
 Dim Pst_Folder_Name 
 Dim MailboxName 
'Dim date1 As Date 
 Dim i As整数
表格（sheet1）Visible = True 
表格（sheet1）选择
 Cells.Select 
 Selection.ClearContents 
单元格（1，1 ）.Value =Date
设置olapp =新的Outlook.Application 
设置olNs = olapp.GetNamespace（MAPI）
设置Fldr = olNs.ActiveExplorer.CurrentFolder.Items 
 MailboxName =[e-mail]
 Pst_Folder_Name =收件箱
设置Fldr = Outlook.Session.Folders（MailboxName）.Folders（Pst_Folder_Name）
i = 2 
对于每个olMail在Fldr.Items 
'为每个olMail在olapp.CurrentFolder.Items 
 ActiveSheet.Cells（i，1）.Value = olMail.ReceivedTime 
 ActiveSheet.Cells（i， 3）.Value = olMail.Subject 
 ActiveSheet.Cells（i，4）.Value = olMail.SenderName 
i = i + 1 
 
下一个olMail 
 End Sub 
  

解决方案

尝试这个

  Sub GetFromInbox（）
 Dim olapp As Outlook .Application 
 Dim olNs As Outlook.Namespace 
 Dim Fldr As Outlook.MAPIFolder 
 Dim olMail As Outlook.MailItem 
 Dim Pst_Folder_Name As String，MailboxName As String 
 Dim i As Long 
 
 MailboxName =[e-mail]
 Pst_Folder_Name =收件箱
设置olapp =新建Outlook.Application 
设置olNs = olapp。 GetNamespace（MAPI）
 
设置Fldr = olNs.Folders（MailboxName）.Folders（Pst_Folder_Name）
 
带表格（sheet1）
 .Cells。 ClearContents 
 .Cells（1，1）.Value =Date
i = 2 
对于每个olMail在Fldr.Items 
'为每个olMail在olapp.CurrentFolder.Items 
 .Cells（i，1）.Value = olMail.ReceivedTime 
 .Cells（i， 3）.Value = olMail.Subject 
 .Cells（i，4）.Value = olMail.SenderName 
i = i + 1 
下一个olMail 
结束
 
 olapp.Quit 
设置olapp = Nothing 
 End Sub 
  

I have two email address. The first is [e-mail] and the second is [e-mail].

I want to copy email subject in microsoft outlook with second address [e-mail] to excel using vba. I use bellow code but it do not work.

Sub GetFromInbox()
Dim olapp As Outlook.Application
Dim olNs As Namespace
Dim Fldr As MAPIFolder
Dim olMail As Variant
Dim Pst_Folder_Name
Dim MailboxName
'Dim date1 As Date
Dim i As Integer
Sheets("sheet1").Visible = True
Sheets("sheet1").Select
Cells.Select
Selection.ClearContents
Cells(1, 1).Value = "Date"
Set olapp = New Outlook.Application
Set olNs = olapp.GetNamespace("MAPI")
Set Fldr = olNs.ActiveExplorer.CurrentFolder.Items
MailboxName = "[e-mail]"
Pst_Folder_Name = "Inbox"
Set Fldr = Outlook.Session.Folders(MailboxName).Folders(Pst_Folder_Name)
i = 2
For Each olMail In Fldr.Items
'For Each olMail In olapp.CurrentFolder.Items
ActiveSheet.Cells(i, 1).Value = olMail.ReceivedTime
ActiveSheet.Cells(i, 3).Value = olMail.Subject
ActiveSheet.Cells(i, 4).Value = olMail.SenderName
i = i + 1

Next olMail
End Sub

解决方案

try this

Sub GetFromInbox()
    Dim olapp As Outlook.Application
    Dim olNs As Outlook.Namespace
    Dim Fldr As Outlook.MAPIFolder
    Dim olMail As Outlook.MailItem
    Dim Pst_Folder_Name As String, MailboxName As String
    Dim i As Long

    MailboxName = "[e-mail]"
    Pst_Folder_Name = "Inbox"
    Set olapp = New Outlook.Application
    Set olNs = olapp.GetNamespace("MAPI")

    Set Fldr = olNs.Folders(MailboxName).Folders(Pst_Folder_Name)

    With Sheets("sheet1")
        .Cells.ClearContents
        .Cells(1, 1).Value = "Date"
        i = 2
        For Each olMail In Fldr.Items
            'For Each olMail In olapp.CurrentFolder.Items
            .Cells(i, 1).Value = olMail.ReceivedTime
            .Cells(i, 3).Value = olMail.Subject
            .Cells(i, 4).Value = olMail.SenderName
            i = i + 1
        Next olMail
    End With

    olapp.Quit
    Set olapp = Nothing
End Sub

这篇关于复制电子邮件主题在Outlook中使用vba与两个电子邮件地址excel？的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！