vba - ejemplos - Subcarpeta de la bandeja de entrada compartida de Outlook Access

vba outlook object properties

Question

Tengo un problema extraño en el siguiente código que uso para extraer información de correo electrónico de Outlook a Excel. A veces, el código funciona a la perfección, pero otras veces obtengo el Error en tiempo de ejecución ''-2147221233 (8004010f)'' . Cuando obtengo este error, es la línea Set objFolder = objMailbox.Folders("Inbox").Folders("ARCHIVE") que tiene el problema.

Estoy ejecutando el código en una bandeja de entrada compartida y tengo la carpeta "ARCHIVO" como una subcarpeta de la bandeja de entrada. Es como si el código no pudiera encontrar la carpeta a pesar de que está allí y puede encontrarla a veces.

Mi suposición sin educación es que, dado que una bandeja de entrada compartida puede tener una actualización de retraso entre todos los usuarios, si hay alguna acción en la carpeta, el código no puede reconocer la carpeta hasta que se actualice o actualice en el servidor.

¿Alguien puede sugerir un código ligeramente diferente para que se ejecute todo el tiempo? ¿O alguien tiene una explicación de por qué solo ocasionalmente funciona como está?

Sub EmailStatsV3()
''Working macro for exporting specific sub-folders of a shared inbox
Dim olMail As Variant
Dim aOutput() As Variant
Dim lCnt As Long
Dim xlApp As Excel.Application
Dim xlSh As Excel.Worksheet
Dim flInbox As Folder
''Gets the mailbox and shared folder inbox
Dim myNamespace As Outlook.NameSpace
Dim myRecipient As Outlook.Recipient
Set myNamespace = Application.GetNamespace("MAPI")
Set myRecipient = myNamespace.CreateRecipient("Operations")
Set objOutlook = CreateObject("Outlook.Application")
Set objNamespace = objOutlook.GetNamespace("MAPI")
Set objInbox = objNamespace.GetSharedDefaultFolder(myRecipient, olFolderInbox)
''Uses the Parent of the Inbox to specify the mailbox
strFolderName = objInbox.Parent
''Specifies the folder (inbox or other) to pull the info from
Set objMailbox = objNamespace.Folders(strFolderName)
Set objFolder = objMailbox.Folders("Inbox").Folders("ARCHIVE") ''Change this line to specify folder
Set colItems = objFolder.Items
''Specify which email items to extract
ReDim aOutput(1 To objFolder.Items.Count, 1 To 10)
For Each olMail In objFolder.Items
If TypeName(olMail) = "MailItem" Then
lCnt = lCnt + 1
aOutput(lCnt, 1) = olMail.SenderEmailAddress ''Sender or SenderName also gives similar output
aOutput(lCnt, 2) = olMail.ReceivedTime ''stats on when received
aOutput(lCnt, 3) = olMail.ConversationTopic ''group based on subject w/o regard to prefix
aOutput(lCnt, 4) = olMail.Subject ''to split out prefix
aOutput(lCnt, 5) = olMail.Categories ''to split out category
aOutput(lCnt, 6) = olMail.Sender
aOutput(lCnt, 7) = olMail.SenderName
aOutput(lCnt, 8) = olMail.To
aOutput(lCnt, 9) = olMail.CC
aOutput(lCnt, 10) = objFolder.Name
End If
Next
''Creates a blank workbook in excel then inputs the info from Outlook
Set xlApp = New Excel.Application
Set xlSh = xlApp.Workbooks.Add.Sheets(1)
xlSh.Range("A1").Resize(UBound(aOutput, 1), UBound(aOutput, 2)).Value = aOutput
xlApp.Visible = True
End Sub

Answer 1

Supongo que está ejecutando el código de Outlook, vea la limpieza que hice.

Option Explicit
Sub EmailStatsV3()
Dim Item As Object
Dim varOutput() As Variant
Dim lngcount As Long
Dim xlApp As Excel.Application
Dim xlSht As Excel.Worksheet
Dim ShareInbox As Outlook.MAPIFolder
Dim olNs As Outlook.NameSpace
Dim olRecip As Outlook.Recipient
Dim SubFolder As Object
Set olNs = Application.GetNamespace("MAPI")
Set olRecip = olNs.CreateRecipient("[email protected]") ''// Owner''s Name or email address
Set ShareInbox = olNs.GetSharedDefaultFolder(olRecip, olFolderInbox)
Set SubFolder = ShareInbox.Folders("Temp") ''Change this line to specify folder
ReDim varOutput(1 To SubFolder.Items.Count, 1 To 10)
For Each Item In SubFolder.Items
If TypeName(Item) = "MailItem" Then
lngcount = lngcount + 1
varOutput(lngcount, 1) = Item.SenderEmailAddress ''Sender or SenderName
varOutput(lngcount, 2) = Item.ReceivedTime ''stats on when received
varOutput(lngcount, 3) = Item.ConversationTopic ''Conversation subject
varOutput(lngcount, 4) = Item.Subject ''to split out prefix
varOutput(lngcount, 5) = Item.Categories ''to split out category
varOutput(lngcount, 6) = Item.Sender
varOutput(lngcount, 7) = Item.SenderName
varOutput(lngcount, 8) = Item.To
varOutput(lngcount, 9) = Item.CC
varOutput(lngcount, 10) = SubFolder.Name
End If
Next
''Creates a blank workbook in excel
Set xlApp = New Excel.Application
Set xlSht = xlApp.Workbooks.Add.Sheets(1)
xlSht.Range("A1").Resize(UBound(varOutput, 1), _
UBound(varOutput, 2)).Value = varOutput
xlApp.Visible = True
End Sub