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
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