Hello,
I've been trying to figure out how to tweak my current Outlook Code. There are two tweaks that I need for this macro.
1) Loop through the e-mails and extract items from emails that have not been added to Sheet1 in the spreadsheet mentioned in the macro.
2) Add any additional data as needed after last row of data.
I feel like I'm almost there, but I can't seem to figure it out.
Thank you
I've been trying to figure out how to tweak my current Outlook Code. There are two tweaks that I need for this macro.
1) Loop through the e-mails and extract items from emails that have not been added to Sheet1 in the spreadsheet mentioned in the macro.
2) Add any additional data as needed after last row of data.
Code:
Sub EmailExtract()
'Working macro for exporting specific sub-folders of a shared inbox
Dim olMail As Variant
Dim aOutput() As Variant
Dim lCnt As Long
Dim wkb As Workbook
Dim xlApp As Excel.Application
Dim xlSh As Excel.Worksheet
Dim flInbox As Folder
Dim lastrow As Long
'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("AAR Team Tracking")
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("Delivery - Correspondent Bank AARs").Folders("CB") '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.ReceivedTime 'stats on when received
aOutput(lCnt, 2) = olMail.Subject 'to split out
aOutput(lCnt, 3) = olMail.Categories 'to split out category
aOutput(lCnt, 4) = olMail.Sender
End If
Next
'Open Excel Template
Set xlApp = CreateObject("Excel.Application")
xlApp.Visible = True
Set wkb = xlApp.Workbooks.Open("H:\jpmDesk\Desktop\Recon\Projects\2017\AAR Macro Creation\Delivery Emails Template.xlsm")
wkb.Sheets("Sheet1").Range("A2").Resize(UBound(aOutput, 1), UBound(aOutput, 2)).Value = aOutput
xlApp.Run wkb.Name & "!SplitSubLn"
End Sub
I feel like I'm almost there, but I can't seem to figure it out.
Thank you