我有一个宏来提取邮箱中的所有电子邮件到Excel工作表。
我需要添加一行来指定邮箱。此配置在用户级别保持固定,因为只能在编程级别更改邮箱。
用户在其Outlook中有多个共享邮箱。他们应该选择要提取的邮箱。
Sub ExtraerCorreosDeOutlook()
Dim OutlookApp As Object
Dim ONameSpace As Object
Dim MyFolder As Object
Dim OItem As Object
Dim Fila As Integer
Dim Mailbox As String
Set OutlookApp = CreateObject("Outlook.Application")
Set ONameSpace = OutlookApp.GetNamespace("MAPI")
Mailbox = Sheets(1).Range("A1").Value 'In this cell I select the mailbox.
Set MyFolder = ONameSpace.Folders(Mailbox).Folders(1)
'Set MyFolder = ONameSpace.Folders("correo@gmail.com").Folders(1) 'If I use this line the macro works well, but the mailbox is fixed.
Range(Range("A2"), ActiveCell.SpecialCells(xlLastCell)).ClearContents
Fila = 2
For Each OItem In MyFolder.Items
Sheets("Hoja1").Cells(Fila, 1).Value = OItem.SenderEmailAddress
Sheets("Hoja1").Cells(Fila, 2).Value = OItem.To
Sheets("Hoja1").Cells(Fila, 3).Value = OItem.Subject
Sheets("Hoja1").Cells(Fila, 4).Value = OItem.ReceivedTime
Sheets("Hoja1").Cells(Fila, 5).Value = OItem.Body
Fila = Fila + 1
Next OItem
Set OutlookApp = Nothing
Set ONameSpace = Nothing
Set MyFolder = Nothing
End Sub
我需要使用单元格值定义邮箱变量。
3条答案
按热度按时间pbpqsu0x1#
使用Range.Text property (Excel)代替值,也使用Trim functions
有关共享邮箱,请参见Excel中的示例
t3psigkw2#
代码取决于共享邮箱是否可见以及是否在Outlook配置文件中配置。如果可见,则可以使用NameSpace.Stores属性迭代所有邮箱/存储,该属性返回表示当前配置文件中所有
Store
对象的Stores
集合对象。配置文件定义一个或多个电子邮件帐户,每个电子邮件帐户都与特定类型的服务器相关联。对于Exchange服务器,存储可以位于服务器上、Exchange公用文件夹中、本地个人文件夹文件(.pst)或脱机文件夹文件(.ost)中。对于POP3、IMAP或HTTP电子邮件服务器,存储是.pst文件。
使用
Stores
和Store
对象可枚举当前会话中所有存储上的所有文件夹和搜索文件夹。由于获取存储中的根文件夹或搜索文件夹需要打开存储,而打开存储会对性能产生影响,因此在决定继续执行此操作之前,可以检查Store.IsOpen
属性。如果该帐户在Outlook中不可见(在Exchange中共享),则可以考虑使用NameSpace.GetSharedDefaultFolder方法,该方法返回
Folder
对象,该对象表示指定用户的指定默认文件夹。此方法用于委派方案中,在该方案中,一个用户将对另一个用户的一个或多个默认文件夹(例如,其共享收件箱文件夹)的访问权限委派给另一个用户。也可以考虑NameSpace.OpenSharedFolder和NameSpace.OpenSharedItem方法。
2admgd593#
谢谢大家。这是我的错误。正如尤金在评论中所说的参考邮箱是错误的。我在单元格中写错了电子邮件。感谢社区的帮助和支持。