Angelo Vernaza
unread,Oct 18, 2014, 5:48:55 PM10/18/14You do not have permission to delete messages in this group
Either email addresses are anonymous for this group or you need the view member email addresses permission to view the original message
to
Hola amigos, tengo un codigo de VBA para extraer y copiar las direcciónes en un archivo de .txt pero el correo la macro y no crea ningún archivo? me podrían ayudar con esto por favor.
'----------------------------------------'
Option Explicit
Sub Mails_a_Texto()
On Error Resume Next
Dim oNameSpace As Outlook.NameSpace
Dim oFolder As Outlook.MAPIFolder
Dim oMailIt As Outlook.MailItem
Dim oSubFolder As Outlook.MAPIFolder
Dim oRecipient As Outlook.Recipient
Dim sRecipients As String
Dim NumArchivo
Const Separador = ";"
Set oNameSpace = Application.GetNamespace("MAPI")
For Each oFolder In oNameSpace.Folders
sRecipients = sRecipients & oFolder & vbLf & vbLf
For Each oSubFolder In oFolder.Folders
If oSubFolder.DefaultItemType = olMailItem Then
For Each oMailIt In oSubFolder.Items
sRecipients = sRecipients & oMailIt.SenderEmailAddress & Separador
For Each oRecipient In oMailIt.Recipients
sRecipients = sRecipients & oRecipient.Address & Separador
Next
Next
End If
Next
Next
NumArchivo = FreeFile
Open "C:\Correos.txt" For Output As #NumArchivo
Print #NumArchivo, sRecipients
Close #NumArchivo
'Debug.Print sRecipients
End Sub