Copying all recipients of a NEW OUTLOOK MAIL into Excel File, when adresses are in distribution list

RLETIZIA

New Member
Joined
May 13, 2016
Messages
2
Good Morning. I want my Vba macro (in Outlook) to write the e-mail adresses of all the recipients of a NEW mail into Excel. I got no problem in doing it when the recipients are written as separate e-mail adresses.. but I cannot do it when the list of e-mail adresses is in a Distribution list. Here the code for the "easy" solution. Can anyone help me to solve the task when there is a distribution list? Thanks a lot to all of you.

Public Tipo As String
Public NumSettore As Integer
Public NumTitoli As Integer
Public NumMultipli As Integer
Public NumNota As Integer

Public Sub TEST()

Dim NewMail As MailItem
Dim recips As Outlook.Recipients
Dim recip As Outlook.Recipient
Dim oggetto As String
Dim indirizzo As String
Dim mittente As String
Dim Percorso As String
Dim OutMail As Object
Dim xlApp As Object
Dim nomefile

Const PR_SMTP_ADDRESS As String = "http://schemas.microsoft.com/mapi/proptag/0x39FE001E"

'show the Form which collects in different fields the informations about the variables
FormMail.Show

'Open the excel file
Percorso = "u:\CRM EQUITASIM\DATABASE\ATTIVITA ANALISTI\RL\Crm_attività_Rl.xlsm"
Set xlApp = CreateObject("Excel.Application")
xlApp.Application.Visible = False
xlApp.Workbooks.Open Percorso
xlApp.Sheets("mails").Select
nomefile = xlApp.activeworkbook.Name
riga = xlApp.Range("A1").Value

'copy all the adresses from the opened mail
Set NewMail = Application.ActiveInspector.currentItem
Set recips = NewMail.Recipients
oggetto = NewMail.Subject

For Each recip In recips
indirizzo = recip.PropertyAccessor.GetProperty(PR_SMTP_ADDRESS)
With xlApp
.Cells(riga, 1).Value = "RL"
.Cells(riga, 3).Value = Date
.Cells(riga, 4).Value = Tipo
.Cells(riga, 2).Value = indirizzo
.Cells(riga, 5).Value = NumTitoli
.Cells(riga, 6).Value = NumSettore
.Cells(riga, 7).Value = NumMultipli
.Cells(riga, 8).Value = NumNota

riga = riga + 1
End With

Next
xlApp.Workbooks(nomefile).Save
xlApp.Workbooks(nomefile).Close
End Sub
 

Excel Facts

Format cells as currency
Select range and press Ctrl+Shift+4 to format cells as currency. (Shift 4 is the $ sign).

Forum statistics

Threads
1,223,270
Messages
6,171,103
Members
452,379
Latest member
IainTru

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top