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

Πώς να προσθέσετε αυτόματα επαφές από ένα email κατά την απάντηση στο Outlook;

Στο Outlook 2010 μπορείτε να ενεργοποιήσετε το Προτεινόμενες επαφές δυνατότητα και αυτόματα να προσθέσετε παραλήπτες ως νέες επαφές. Ωστόσο, αυτό Προτεινόμενες επαφές Η δυνατότητα δεν υποστηρίζεται στο Outlook 2013 και 2016. Εδώ, θα εισαγάγω ένα VBA για να προσθέσω αυτόματα τον αποστολέα και τους παραλήπτες ενός email ως νέες επαφές κατά την απάντηση στο Outlook.

Αυτόματη προσθήκη επαφών από ένα email του Outlook κατά την απάντηση με το VBA

Καρτέλα Office - Ενεργοποίηση επεξεργασίας καρτέλας και περιήγησης στο Office και να κάνετε την εργασία πολύ πιο εύκολη ...
Kutools για Outlook - Φέρνει 100 ισχυρές προηγμένες δυνατότητες στο Microsoft Outlook
  • Αυτόματο CC / BCC με κανόνες κατά την αποστολή email · Αυτόματη προώθηση Πολλαπλά email μέσω κανόνων. Αυτόματη απάντηση χωρίς διακομιστή ανταλλαγής και περισσότερες αυτόματες δυνατότητες ...
  • Προειδοποίηση BCC - εμφάνιση μηνύματος όταν προσπαθείτε να απαντήσετε όλα εάν η διεύθυνση αλληλογραφίας σας βρίσκεται στη λίστα BCC. Υπενθύμιση όταν λείπουν συνημμένακαι περισσότερες λειτουργίες υπενθύμισης ...
  • Απάντηση (Όλα) με όλα τα συνημμένα στη συνομιλία μέσω ταχυδρομείου. Απάντηση σε πολλά email ταυτόχρονα. Αυτόματη προσθήκη χαιρετισμού κατά την απάντηση Αυτόματη προσθήκη ημερομηνίας και ώρας στο θέμα ...
  • Εργαλεία συνημμένου: Αυτόματη αποσύνδεση, Συμπίεση όλων, Μετονομασία όλων, Αυτόματη αποθήκευση όλων ... Γρήγορη αναφορά, Καταμέτρηση επιλεγμένων μηνυμάτων, Κατάργηση διπλών μηνυμάτων και επαφών ...
  • Περισσότερες από 100 προηγμένες δυνατότητες θα λύστε τα περισσότερα από τα προβλήματά σας στο Outlook 2021 - 2010 ή στο Office 365. Πλήρεις δυνατότητες δωρεάν δοκιμή 60 ημερών.

Αυτόματη προσθήκη επαφών από ένα email του Outlook κατά την απάντηση με το VBA

Αυτό το VBA θα προσθέσει αυτόματα τον αποστολέα και όλους τους παραλήπτες ενός email ως νέες επαφές όταν απαντάτε στο email στο Outlook. Κάντε τα εξής:

1. Τύπος άλλος + F11 για να ανοίξετε το παράθυρο της Microsoft Visual Basic for Applications.

2. Αναπτύξτε το Project1 και κάντε διπλό κλικ Αυτό το OutlookSession για να το ανοίξετε και, στη συνέχεια, επικολλήστε κάτω από τον κώδικα VBA στο παράθυρο ThisOutlookSession. Δείτε το στιγμιότυπο οθόνης:

VBA: Αυτόματη προσθήκη επαφών από ένα μήνυμα ηλεκτρονικού ταχυδρομείου κατά την απάντηση στο 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. Αποθηκεύστε τον κώδικα VBA και επανεκκινήστε το Microsoft Outlook.

Από τώρα και στο εξής, όταν απαντάτε ένα email στο Outlook, ο αποστολέας αυτού του μηνύματος και όλοι οι παραλήπτες θα αποθηκεύονται αυτόματα ως νέες επαφές στον προεπιλεγμένο φάκελο επαφών του προεπιλεγμένου λογαριασμού email.


Σχετικά άρθρα


Kutools για Outlook - Φέρνει 100 προηγμένες δυνατότητες στο Outlook και κάνει την εργασία πολύ πιο εύκολη!

  • Αυτόματο CC / BCC με κανόνες κατά την αποστολή email · Αυτόματη προώθηση Πολλαπλά μηνύματα ηλεκτρονικού ταχυδρομείου κατά παραγγελία. Αυτόματη απάντηση χωρίς διακομιστή ανταλλαγής και περισσότερες αυτόματες δυνατότητες ...
  • Προειδοποίηση BCC - εμφάνιση μηνύματος όταν προσπαθείτε να απαντήσετε σε όλα εάν η διεύθυνση αλληλογραφίας σας βρίσκεται στη λίστα BCC; Υπενθύμιση όταν λείπουν συνημμένακαι περισσότερες λειτουργίες υπενθύμισης ...
  • Απάντηση (Όλα) Με όλα τα συνημμένα στη συνομιλία μέσω ταχυδρομείου; Απάντηση σε πολλά email σε δευτερόλεπτα; Αυτόματη προσθήκη χαιρετισμού κατά την απάντηση Προσθήκη ημερομηνίας στο θέμα ...
  • Εργαλεία συνημμένων: Διαχείριση όλων των συνημμένων σε όλα τα μηνύματα, Αυτόματη απόσπαση, Συμπίεση όλων, Μετονομασία όλων, Αποθήκευση όλων ... Γρήγορη αναφορά, Καταμέτρηση επιλεγμένων μηνυμάτων...
  • Ισχυρά ανεπιθύμητα email κατά παραγγελία? Κατάργηση διπλότυπων μηνυμάτων και επαφών... Σας επιτρέπουν να κάνετε πιο έξυπνα, πιο γρήγορα και καλύτερα στο Outlook.
shot kutools outlook kutools καρτέλα 1180x121
shot kutools outlook kutools συν καρτέλα 1180x121
 
Σχόλια (1)
Δεν υπάρχουν ακόμη βαθμολογίες. Γίνε ο πρώτος που θα αξιολογήσετε!
Αυτό το σχόλιο ελαχιστοποιήθηκε από τον συντονιστή του ιστότοπου
Γεια σας, σας ευχαριστώ για αυτόν τον κωδικό.
Αλλά αντιγράφει (στην περίπτωσή μου τουλάχιστον) τις επαφές όσες φορές τους γράφω. Καμια ιδεα?
Παρεμπιπτόντως, στις επιλογές του outlook, είναι επιλεγμένο το πλαίσιο "αναζήτηση διπλότυπων κατά την αποθήκευση μιας νέας επαφής".
Δεν υπάρχουν σχόλια δημοσιεύτηκε ακόμα
Αφήστε τα σχόλιά σας
Δημοσίευση ως επισκέπτης
×
Αξιολογήστε αυτήν την ανάρτηση:
0   Χαρακτήρες
Προτεινόμενες τοποθεσίες

Ακολουθησε μας

Πνευματικά δικαιώματα © 2009 - www.extendoffice.com. | Ολα τα δικαιώματα διατηρούνται. Τροφοδοτείται από ExtendOffice. | Sitemap
Το Microsoft και το λογότυπο του Office είναι εμπορικά σήματα ή σήματα κατατεθέντα της Microsoft Corporation στις Ηνωμένες Πολιτείες ή / και σε άλλες χώρες.
Προστατεύεται από το Sectigo SSL