Přejít k hlavnímu obsahu

Jak automaticky přidat kontakty z e-mailu při odpovědi v aplikaci Outlook?

V aplikaci Outlook 2010 můžete povolit Navrhované kontakty funkce a automaticky přidávat příjemce jako nové kontakty. Toto však Navrhované kontakty Tato funkce není v Outlooku 2013 a 2016 podporována. Zde představím VBA, které při odpovídání v Outlooku automaticky přidá odesílatele a příjemce e-mailu jako nové kontakty.

Automatické přidávání kontaktů z e-mailu aplikace Outlook při odpovědi pomocí VBA

Karta Office – Povolte úpravy a procházení na kartách v Microsoft Office, díky čemuž bude práce hračkou
Kutools pro Outlook – Vylepšete Outlook se 100+ pokročilými funkcemi pro vynikající efektivitu
Vylepšete svůj Outlook 2021–2010 nebo Outlook 365 pomocí těchto pokročilých funkcí. Užijte si komplexní 60denní bezplatnou zkušební verzi a vylepšete svůj e-mailový zážitek!

Automatické přidávání kontaktů z e-mailu aplikace Outlook při odpovědi pomocí VBA

Tato VBA automaticky přidá odesílatele a všechny příjemce e-mailu jako nové kontakty, když odpovíte na e-mail v aplikaci Outlook. Postupujte prosím následovně:

1. lis Další + F11 klávesy pro otevření okna Microsoft Visual Basic pro aplikace.

2. Rozbalte Project1 a dvakrát klikněte ThisOutlookSession otevřete jej a poté vložte pod kód VBA do okna ThisOutlookSession. Viz snímek obrazovky:

VBA: Automatické přidávání kontaktů z e-mailu při odpovědi v aplikaci 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. Uložte kód VBA a restartujte Microsoft Outlook.

Od této chvíle, když odpovíte na e-mail v aplikaci Outlook, bude odesílatel tohoto e-mailu a všichni příjemci automaticky uloženi jako nové kontakty do výchozí složky kontaktů výchozího e-mailového účtu.


Související články


Nejlepší nástroje pro produktivitu v kanceláři

Kutools pro aplikaci Outlook - Více než 100 výkonných funkcí, které doplní váš Outlook

???? Automatizace e-mailu: Mimo kancelář (k dispozici pro POP a IMAP)  /  Naplánujte odesílání e-mailů  /  Automatická kopie/skrytá kopie podle pravidel při odesílání e-mailu  /  Automatické přeposílání (pokročilá pravidla)   /  Automatické přidání pozdravu   /  Automaticky rozdělte e-maily pro více příjemců na jednotlivé zprávy ...

📨 Email management: Snadné vyvolání e-mailů  /  Blokujte podvodné e-maily podle předmětů a dalších  /  Odstranit duplicitní e-maily  /  pokročilé vyhledávání  /  Konsolidovat složky ...

📁 Přílohy ProDávkové uložení  /  Dávkové odpojení  /  Dávková komprese  /  Automaticky uložit   /  Automatické odpojení  /  Automatické komprimování ...

???? Rozhraní Magic: 😊 Více pěkných a skvělých emotikonů   /  Zvyšte produktivitu své aplikace Outlook pomocí zobrazení s kartami  /  Minimalizujte aplikaci Outlook namísto zavírání ...

???? Zázraky na jedno kliknutí: Odpovědět všem s příchozími přílohami  /   E-maily proti phishingu  /  🕘Zobrazit časové pásmo odesílatele ...

👩🏼‍🤝‍👩🏻 Kontakty a kalendář: Dávkové přidání kontaktů z vybraných e-mailů  /  Rozdělit skupinu kontaktů na jednotlivé skupiny  /  Odeberte připomenutí narozenin ...

Přes 100 Vlastnosti Očekávejte svůj průzkum! Kliknutím sem zobrazíte další informace.

Více       Stažení zdarma      Nákup
 

 

Comments (1)
No ratings yet. Be the first to rate!
This comment was minimized by the moderator on the site
Hello, thank you for this code.
But it duplicates (in my case at least) the contacts as many times as I write to them. Any idea?
By the way, in outlook options, the box "search for duplicates when saving a new contact" is checked.
There are no comments posted here yet
Please leave your comments in English
Posting as Guest
×
Rate this post:
0   Characters
Suggested Locations