2 Μέθοδοι για τη δημιουργία μιας ομάδας επαφών από μια λίστα επαφών σε ένα αρχείο Excel

Εάν θέλετε να δημιουργήσετε μια ομάδα επαφών του Outlook από τη λίστα επαφών σε ένα αρχείο Excel, μπορείτε να χρησιμοποιήσετε τις 2 μεθόδους που παρουσιάζονται σε αυτό το άρθρο.

Ορισμένοι χρήστες αναζητούν έναν τρόπο να δημιουργήσουν γρήγορα μια ομάδα επαφών του Outlook από ένα αρχείο Excel που περιέχει μια λίστα επαφών. Φυσικά, μπορείτε να δημιουργήσετε μια τέτοια ομάδα επαφών με μη αυτόματο τρόπο. Ωστόσο, είναι λίγο ενοχλητικό. Ως εκ τούτου, εκτός από τα χειροκίνητα μέσα, εδώ θα εισαγάγουμε επιπλέον μια άλλη γρήγορη μέθοδο που χρησιμοποιεί VBA.

Μέθοδος 1: Δημιουργία με μη αυτόματο τρόπο

1. Στην αρχή, ανοίξτε το αρχείο Excel.
2. Στη συνέχεια, επιλέξτε τις στήλες που περιέχουν τις διευθύνσεις email. Προαιρετικά, μπορείτε επίσης να συμπεριλάβετε τις στήλες για ονόματα.
3. Στη συνέχεια, πατήστε "Ctrl + C" σε όλα τα επιλεγμένα κελιά.
4. Στη συνέχεια, ξεκινήστε το πρόγραμμα Outlook.
5. Στη συνέχεια, μεταβείτε στο παράθυρο Επαφών και πατήστε το κουμπί "Νέα Ομάδα Επαφών".
6. Στη συνέχεια, κάντε κλικ στην επιλογή "Προσθήκη μελών" -> "Από τις επαφές του Outlook"
7. Αργότερα κάντε κλικ στο πεδίο "Μέλη ->" και πατήστε τα πλήκτρα "Ctrl + V" για να επικολλήσετε τις επαφές που αντιγράψατε προηγουμένως.
8. Πατήστε το κουμπί "OK".
9. Στη συνέχεια, ορίστε ένα όνομα για τη νέα ομάδα επαφών.
10. Τέλος, κάντε κλικ στο "Αποθήκευση & Κλείσιμο" για να αποθηκεύσετε αυτήν την ομάδα.

Μέθοδος 2: Δημιουργία μέσω του Outlook VBA

1. Πρώτα, πατήστε τα πλήκτρα "Alt + F11" στο Outlook.
2. Στη συνέχεια, ανοίξτε μια νέα ενότητα.
3. Στη συνέχεια, αντιγράψτε και επικολλήστε τους ακόλουθους κωδικούς σε αυτό.

Sub CreateContactGroupfromExcel()
    Dim objContactsFolder As Outlook.Folder
    Dim objContact As Outlook.ContactItem
    Dim objContactGroup As Outlook.DistListItem
    Dim objExcelApp As New Excel.Application
    Dim objExcelWorkbook As Excel.Workbook
    Dim objExcelWorksheet As Excel.Worksheet
    Dim nLastRow As Integer
    Dim nCurrentRow As Integer
    Dim objNameCell As Excel.Range
    Dim objEmailCell As Excel.Range
    Dim strName As String
    Dim strEmail As String
    Dim objTempMail As Outlook.MailItem
    Dim objRecipients As Outlook.Recipients

    Set objContactsFolder = Outlook.Application.Session.GetDefaultFolder(olFolderContacts)
    Set objContactGroup = Outlook.Application.CreateItem(olDistributionListItem)
    'You can change the contact group name
    objContactGroup.DLName = "Group Name"
 
    Set objExcelApp = CreateObject("Excel.Application")
    'You should change the path to your own Excel file
    Set objExcelWorkbook = objExcelApp.Workbooks.Open("E:\Contacts.xlsx")
    Set objExcelWorksheet = objExcelWorkbook.Sheets(1)
    objExcelWorksheet.Activate
 
    nLastRow = objExcelWorksheet.UsedRange.Rows.Count
    'The "A2" varies with the first contact's name cell in your own Excel file
    Set objNameCell = objExcelApp.Range("A2")
    objNameCell.Select
 
    While nCurrentRow <= nLastRow
          nCurrentRow = objNameCell.Row
 
          strName = objNameCell.Value
 
          If strName = "" Then
             GoTo NextRow
          End If
 
          Set objEmailCell = objExcelApp.ActiveCell.Offset(0, 1)
          strEmail = objEmailCell.Value
 
          Set objContact = objContactsFolder.Items.Find("[FullName] = '" & strName & "'")
 
          'If there is no such a contact, create it.
          If objContact Is Nothing Then
             Set objContact = Outlook.Application.CreateItem(olContactItem)
             With objContact
                  .FullName = strName
                  .Email1Address = strEmail
                  .Save
             End With
          End If
 
          'Add the contacts to the new contact group
          Set objTempMail = Application.CreateItem(olMailItem)
          objTempMail.Recipients.Add (strName)
          Set objRecipients = objTempMail.Recipients
          objContactGroup.AddMembers objRecipients

    NextRow:
          Set objNameCell = objExcelApp.ActiveCell.Offset(1, 0)
          objNameCell.Select
    Wend
 
    'Use "objContactGroup.Save" to straightly save it
    objContactGroup.Display
    objTempMail.Close olDiscard
    objExcelApp.Quit
End Sub

4. Μετά από αυτό, πατήστε το εικονίδιο "Εκτέλεση" στη γραμμή εργαλείων.
5. Ταυτόχρονα, θα εμφανιστεί μια νέα ομάδα επαφών, όπως το ακόλουθο στιγμιότυπο οθόνης:

Χειριστείτε επιδέξια προβλήματα του Outlook

Εάν αντιμετωπίζετε συχνά διάφορα σφάλματα στο Outlook, συνιστάται ιδιαίτερα να διατηρείτε ένα εξέχον και αξιόπιστο Ανάκτηση του Outlook εργαλείο κοντά, όπως DataNumen Outlook Repair. Σε αυτήν την περίπτωση, μπορείτε να το χρησιμοποιήσετε για να αντιμετωπίσετε έγκαιρα τα ενοχλητικά ζητήματα μέσω αυτού.

Εισαγωγή συγγραφέα:

Η Shirley Zhang είναι ειδικός ανάκτησης δεδομένων στο DataNumen, Inc., η οποία είναι ο παγκόσμιος ηγέτης στις τεχνολογίες ανάκτησης δεδομένων, συμπεριλαμβανομένων ανάκτηση sql και προϊόντα λογισμικού επισκευής προοπτικών. Για περισσότερες πληροφορίες επισκεφθείτε www.datanumen.com