Pokud chcete vytvořit skupinu kontaktů aplikace Outlook ze seznamu kontaktů v souboru aplikace Excel, můžete použít 2 metody představené v tomto článku.
Někteří uživatelé hledají způsob, jak rychle vytvořit skupinu kontaktů aplikace Outlook ze souboru aplikace Excel, který obsahuje seznam kontaktů. Samozřejmě můžete takovou skupinu kontaktů vytvořit ručně. Je to však trochu problematické. Proto kromě manuálních prostředků zde dále představíme další rychlou metodu, která používá VBA.

Metoda 1: Vytvořit ručně
- Hned na začátku otevřete soubor Excel.
- Poté vyberte sloupce obsahující e-mailové adresy. Volitelně můžete také zahrnout sloupce pro jména.
- Poté stiskněte „Ctrl + C“ pro všechny vybrané buňky.
- Poté spusťte program Outlook.
- Poté přepněte do podokna Kontakty a stiskněte tlačítko „Nová skupina kontaktů“.
- Následně klikněte na „Přidat členy“ -> „Z kontaktů aplikace Outlook“
- Později klikněte do pole „Členové ->“ a stisknutím kláves „Ctrl + V“ vložte dříve zkopírované kontakty.
- Stiskněte tlačítko „OK“.
- Poté přiřaďte název nové skupině kontaktů.
- Nakonec tuto skupinu uložte kliknutím na „Uložit a zavřít“.
Metoda 2: Vytváření prostřednictvím Outlook VBA
- Na prvním místě stiskněte v aplikaci Outlook klávesy „Alt + F11“.
- Poté otevřete nový modul.
- Následně do něj zkopírujte a vložte následující kódy.
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
- Poté stiskněte ikonu „Spustit“ na panelu nástrojů.
- Najednou se zobrazí nová skupina kontaktů, například následující snímek obrazovky:
Zvládněte nepříjemné potíže s Outlookem dovedně
Pokud se v Outlooku často setkáváte s různými chybami, důrazně doporučujeme zachovat preeminent a spolehlivost Obnova aplikace Outlook nástroj v okolí, jako DataNumen Outlook Repair. V tomto případě jej můžete použít k včasnému řešení nepříjemných problémů.
Úvod autora:
Shirley Zhang je expertem na obnovu dat DataNumen, Inc., která je světovým lídrem v oblasti technologií pro obnovu dat, včetně obnovit sql a výhledové softwarové produkty pro opravy. Pro více informací navštivte www.datanumen.com



