Импорт контактной группы из Outlook - excel vba

У меня есть следующий код для импорта всех контактов из Outlook.Импорт контактной группы из Outlook - excel vba

Dim olApp As Outlook.Application 
Dim olNamespace As Outlook.Namespace 
Dim olFolder As Outlook.MAPIFolder 
Dim olConItems As Outlook.Items 
Dim olItem As Object 
Set olApp = New Outlook.Application 
Set olNamespace = olApp.GetNamespace("MAPI") 
Set olFolder = olNamespace.GetDefaultFolder(olFolderContacts) 
Set olConItems = olFolder.Items 


'HERE IS THE PROBLEM I do not know how to do so that there are only contacts from my desired group in the olConItems collection 
For Each olItem In olConItems 
    If TypeName(olItem) = "ContactItem" Then 
    'Do something - no problem I just do not want to post unnecessary code 
    End If 
Next olItem

Мне нужно импортировать только те, которые принадлежат к определенной группе контактов. Как я могу получить свойство группы контактов? Это как-то разоблачено?

источник

2014-10-31 david

На самом деле это не так. Они хотят отправлять электронную почту через Outlook. Я хочу экспортировать определенные группы. Они предлагают просто использовать имя группы в качестве получателя. Но в моем случае это не сработает. – david

С чем вы столкнулись? Поиск DL или экспорт его членов? Что именно вы подразумеваете под «экспортом»? Сохранение в виде файла в определенном формате? Или просто чтение свойств? –

Ну с помощью экспорта я имею в виду, например, скопировать их в свой листок, добавив код в раздел '/ * Do something * /'. Но это не проблема. Моя проблема в том, что я donk знаю, как получить коллекцию контактов в какой-то группе в Outlook. Допустим, у меня есть группа под названием «Клиенты», и я хочу использовать ее в качестве источника для цикла 'for each'. Но я не знаю, чтобы присоединиться к этой конкретной коллекции – david

Петля от 1 до DistListItem.MemberCount и вызов DistListItem.GetMember - он вернет объект Получателя. Если свойств объекта Получателя недостаточно, прочитайте «Recipient.AddressEntry», чтобы получить объект AddressEntry.

источник

2015-02-14 02:45:33

Подпрограмма извлекает имена из контактной группы «MyGroupName» в Outlook и перечисляет их на активной рабочей таблице.

Sub Get_Email_List() 

    Dim I As Integer  
    Dim A1 As String 
    Dim B() As String 
    Dim WSN as String 
    Dim Group as String 

    Dim olApp As Outlook.Application 
    Dim myNamespace As Object 
    Dim myFolder As Object 
    Dim myItem As Object 
    Dim WordApp As Object 

    Application.ScreenUpdating = False 

    WSN = ActiveSheet.Name 
    Group = "MyGroupName" 

    Sheets(WSN).Select 
    Selection.Clear 
    Columns("A:D").Select 
    Selection.NumberFormat = "@" 
    Cells(1, 1).Select 

    Set olApp = New Outlook.Application 
    With olApp 
     Set myNamespace = .GetNamespace("MAPI") 
     Set myFolder = myNamespace.GetDefaultFolder(olFolderContacts) 
     Set myItem = myFolder.Items(Group) 
     For I = 1 To myItem.MemberCount 
      Cells(I + 1, 1) = myItem.GetMember(I).Name 
      Cells(I + 1, 3) = myItem.GetMember(I).Address 
     Next I 
    End With 
    Set olApp = Nothing 
    Set myNamespace = Nothing 
    Set myFolder = Nothing 
    Set myItem = Nothing 

    Range("A1") = "Display Name" 
    Range("B1") = "Last Name" 
    Range("C1") = "Email Address" 
    Range("D1") = "Composite Email Address" 
    Range("A2:B" & I + 1).Select 
    Selection.Cells.Replace What:="'", Replacement:="", LookAt:=xlPart, SearchOrder:= _ 
     xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False 

    A1 = "" 
    I = 2 
    While Cells(I, 1) > "" 
     If InStr(1, Cells(I, 1), ")") > 0 Then _ 
      Cells(I, 1) = Left(Cells(I, 1), InStr(1, Cells(I, 1), "(") - 2) 

     B = Split(Cells(I, 1), " ") 
     Cells(I, 2) = Trim(B(UBound(B, 1))) 
     If I > 1 Then A1 = A1 & "; " 
     A1 = A1 & Trim(Cells(I, 1)) 
     Cells(I, 4) = Cells(I, 1) & " <" & Cells(I, 3) & ">" 
     I = I + 1 
    Wend 

    ActiveWorkbook.Worksheets(WSN).Sort.SortFields.Clear 
    ActiveWorkbook.Worksheets(WSN).Sort.SortFields.Add Key:=Range("B2:B" & I), _ 
     SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal 
    With ActiveWorkbook.Worksheets(WSN).Sort 
     .SetRange Range("A2:D" & I) 
     .Header = xlGuess 
     .MatchCase = False 
     .Orientation = xlTopToBottom 
     .SortMethod = xlPinYin 
     .Apply 
    End With 

    Columns("A:C").Select 
    Selection.ColumnWidth = 28 
    Columns("D:D").Select 
    Selection.ColumnWidth = 48 

    Range("A1:D1").Select 
    Selection.Font.FontStyle = "Bold" 
    Range("A2").Select 
    With ActiveWindow 
     .SplitColumn = 0 
     .SplitRow = 1 
    End With 
    ActiveWindow.FreezePanes = True 
    Range("A1").Select 
    Application.CutCopyMode = False 
    Application.ScreenUpdating = True 
End Sub

источник

2016-12-17 05:23:55

Импорт контактной группы из Outlook - excel vba

ответ

Смежные вопросы