Получить весь список рассылки из вашего Outlook 2007 - PullRequest
Новая
       7

Получить весь список рассылки из вашего Outlook 2007

0 голосов
/ 12 декабря 2018

Мне нужно получить весь список рассылки, который я создал в моем outlook 2007, фактически не просматривая все мои контакты.

1 Ответ

0 голосов
/ 13 декабря 2018

Попробуйте запустить этот код и дайте мне знать, работает ли он для вас.По сути, он вытягивает все ваши глобальные адресные контакты (с дополнительной информацией) из outlook и помещает их на новый лист.Откройте модуль vba и в панели задач выберите «TOOLS» (рядом с «RUN»).Далее выберите «ССЫЛКИ».Спускайтесь вниз, пока не увидите «MICROSOFT OUTLOOK 16.0 Object Library» и проверьте его.Надеюсь, это имеет смысл. 

Dim olApp As Outlook.Application
Dim olNameSpace     As Namespace
Dim olAddrList      As AddressList
Dim olAddrEntry     As AddressEntry
Dim olExchgnUser    As ExchangeUser
Dim sh              As Worksheet
Dim lCnt            As Long

Set olApp = CreateObject("Outlook.Application")
Set olNameSpace = olApp.GetNamespace("MAPI")
Set olAddrList = olNameSpace.AddressLists("Global Address List")


Set sh = ThisWorkbook.Worksheets.Add


With sh
    .Cells(1, 1) = "NAME"
    .Cells(1, 2) = "FIRST NAME"
    .Cells(1, 3) = "LAST NAME"
    .Cells(1, 4) = "ALIAS"
    .Cells(1, 5) = "JOB TITLE"
    .Cells(1, 6) = "DEPARTMENT"
End With


lCnt = 2

For Each olAddrEntry In olAddrList.AddressEntries


    Set olExchgnUser = olAddrEntry.GetExchangeUser

    On Error Resume Next

    With olExchgnUser
        sh.Cells(lCnt, 1) = .Name
        sh.Cells(lCnt, 2) = .FirstName
        sh.Cells(lCnt, 3) = .LastName
        sh.Cells(lCnt, 4) = .Alias
        sh.Cells(lCnt, 5) = .JobTitle
        sh.Cells(lCnt, 6) = .Department
    End With

    Application.StatusBar = "Processing contact " & lCnt & "..."

    If Err.Number = 0 Then lCnt = lCnt + 1
    Err.Clear
    On Error GoTo 0

Next olAddrEntry
Application.StatusBar = ""

MsgBox "Outlook Extraction Complete",vbinformation,"Outlook Extraction"

End Sub
...