Note: The other languages of the website are Google-translated. Back to English

¿Cómo agregar automáticamente contactos desde un correo electrónico al responder en Outlook?

En Outlook 2010 puede habilitar el Contactos sugeridos función y agregar automáticamente destinatarios como nuevos contactos. Sin embargo, esto Contactos sugeridos La función no es compatible con Outlook 2013 y 2016. Aquí, presentaré un VBA para agregar automáticamente el remitente y los destinatarios de un correo electrónico como nuevos contactos al responder en Outlook.

Agregue contactos automáticamente desde un correo electrónico de Outlook al responder con VBA

Pestaña Office: habilite la edición y navegación con pestañas en Office, y haga el trabajo mucho más fácil ...
Kutools para Outlook: trae 100 potentes funciones avanzadas a Microsoft Outlook
  • Auto CC / BCC por reglas al enviar correo electrónico; Reenvío automático Varios correos electrónicos por reglas; Respuesta automática sin servidor de intercambio y más funciones automáticas ...
  • Advertencia de BCC - mostrar mensaje cuando intente responder a todos si su dirección de correo está en la lista CCO; Recordar si faltan archivos adjuntosy más funciones de recordatorio ...
  • Responder (todos) con todos los archivos adjuntos en la conversación por correo; Responder muchos correos electrónicos a la vez; Agregar saludo automáticamente cuando responda; Agregar automáticamente fecha y hora al asunto ...
  • Herramientas de adjunto: Desconexión automática, Comprimir todo, Renombrar todo, Guardar todo automáticamente ... Informe rápido, Contar correos seleccionados, Eliminar correos y contactos duplicados ...
  • Más de 100 funciones avanzadas resuelve la mayoría de tus problemas en Outlook 2021 - 2010 u Office 365. Funciones completas Prueba gratuita de 60 días.

Agregue contactos automáticamente desde un correo electrónico de Outlook al responder con VBA

Este VBA agregará automáticamente el remitente y todos los destinatarios de un correo electrónico como nuevos contactos cuando responda el correo electrónico en Outlook. Haz lo siguiente:

1. prensa otro + F11 teclas para abrir la ventana de Microsoft Visual Basic para Aplicaciones.

2. Expanda el Proyecto1 y haga doble clic Esta sesión de Outlook para abrirlo y luego pegar debajo del código VBA en la ventana ThisOutlookSession. Ver captura de pantalla:

VBA: Agregar contactos automáticamente desde un correo electrónico al responder en Outlook

Public WithEvents xExplorer As Outlook.Explorer
Public WithEvents xMailItem As Outlook.MailItem
Sub Application_Startup()
Set xExplorer = Outlook.Application.ActiveExplorer
End Sub

Private Sub xExplorer_SelectionChange()
On Error Resume Next
Set xMailItem = xExplorer.Selection.Item(1)
End Sub

Private Sub xMailItem_Reply(ByVal Response As Object, Cancel As Boolean)
Dim xNameSpace As NameSpace
Dim xSenderAddress As String
Dim xContactItems As Outlook.Items
Dim i, k As Long
Dim xFilterAddress As String
Dim xContact As Outlook.ContactItem
Dim xNewContact As Outlook.ContactItem
Dim Arr() As String
Dim ArrName() As String
Dim xArrCount As Integer
On Error Resume Next
ReDim Arr(xMailItem.Recipients.Count + 1)
ReDim ArrName(xMailItem.Recipients.Count + 1)
xSenderAddress = xMailItem.SenderEmailAddress
Arr(0) = xSenderAddress
ArrName(0) = xMailItem.SenderName
For i = LBound(Arr) + 1 To UBound(Arr) - 1
Arr(i) = xMailItem.Recipients.Item(i).Address
ArrName(i) = xMailItem.Recipients.Item(i).Name
Next i
Set xNameSpace = Outlook.Application.GetNamespace("MAPI")
Set xContactItems = xNameSpace.GetDefaultFolder(olFolderContacts).Items
For i = LBound(Arr) To UBound(Arr) - 1
For k = 1 To 3
xFilterAddress = "[Email" & k & "Address] = " & Arr(i)
Set xContact = xContactItems.Find(xFilterAddress)
If Not (xContact Is Nothing) Then
Exit For
End If
Next k
If xContact Is Nothing Then
Set xNewContact = Outlook.Application.CreateItem(olContactItem)
With xNewContact
.FullName = ArrName(i)
.Email1Address = Arr(i)
.Categories = "From Email"
.Save
End With
End If
Next i
End Sub

3. Guarde el código VBA y reinicie Microsoft Outlook.

A partir de ahora, cuando responda un correo electrónico en Outlook, el remitente de este correo electrónico y todos los destinatarios se guardarán como nuevos contactos automáticamente en la carpeta de contactos predeterminada de la cuenta de correo electrónico predeterminada.


Artículos Relacionados


Kutools para Outlook: trae 100 funciones avanzadas a Outlook y hace que el trabajo sea mucho más fácil.

  • Auto CC / BCC por reglas al enviar correo electrónico; Reenvío automático Varios correos electrónicos personalizados; Respuesta automática sin servidor de intercambio y más funciones automáticas ...
  • Advertencia de BCC - mostrar mensaje cuando intente responder a todos si su dirección de correo está en la lista CCO; Recordar si faltan archivos adjuntosy más funciones de recordatorio ...
  • Responder (todos) con todos los archivos adjuntos en la conversación de correo; Responder muchos correos electrónicos en segundos; Agregar saludo automáticamente cuando responda; Agregar fecha al asunto ...
  • Herramientas de archivos adjuntos: administre todos los archivos adjuntos en todos los correos, Desconexión automática, Comprimir todo, Renombrar todo, Guardar todo ... Informe rápido, Contar correos seleccionados...
  • Potentes correos electrónicos no deseados por costumbre; Eliminar correos y contactos duplicados... Le permite hacerlo de forma más inteligente, más rápida y mejor en Outlook.
tiro kutools outlook kutools pestaña 1180x121
tiro kutools outlook kutools plus pestaña 1180x121
 
Comentarios (1)
Aún no hay calificaciones. ¡Sé el primero en calificar!
Este comentario fue minimizado por el moderador en el sitio
Hola, gracias por este código.
Pero duplica (al menos en mi caso) los contactos tantas veces como les escribo. ¿Alguna idea?
Por cierto, en las opciones de Outlook, la casilla "buscar duplicados al guardar un nuevo contacto" está marcada.
No hay comentarios publicados aquí todavía
Por favor, deje sus comentarios en inglés.
Publicar como invitado
×
Califica esta publicación:
0   Personajes
Ubicaciones sugeridas

Siganos

Copyright © 2009 - www.extendoffice.com. | Reservados todos los derechos. Energizado por ExtendOffice, | Mapa del Sitio
Microsoft y el logotipo de Office son marcas comerciales o marcas comerciales registradas de Microsoft Corporation en los Estados Unidos y / o en otros países.
Protegido por Sectigo SSL