Excel Forum - Porady, Pomoc, Excel Help, Excel FAQ - Dane z listy globalnej kontaktów Outlook do Excela

Matuzam · EXCELent Man **Pomógł:** 20 razy Posty: 102

Mam w excelu listę z nazwiskami i imionami pracowników. chciałbym odpowiednie dane pobrać z właściwości kontaktu z Outlooka (Globalna Lista Adresów, MS Exchange). Część danych z karty Ogólne, część z Telefon. Jakby ktoś mi jakiś szkielet mógł podać, bo poza stworzeniem obiektu Outlook.Application i LogOn, a potem pętli obiektowej po komórkach z danymi to nie wiem jak to ugryźć.

PS. Pierwsze próby współpracy z Outlookiem, jeśli podałem za mało lub nie podałem istotnych info to z góry przepraszam.

OShon · Wysłany: 2011-12-16, 21:17

Czyli z Outloka do Excela, czy z Excela do Outlooka?

Matuzam · EXCELent Man **Pomógł:** 20 razy Posty: 102

Z Outlooka do Excela.

Może dokładniej opiszę jakby to wyglądało manualnie....

Wyszukuje po imieniu i nazwisku w książce adresowej Outlooka, przepisuję kilka informacji z właściwości kontaktu (Stanowisko, Dział Firmy, Nr telefonu, Nr telefonu służbowego) i przerzucam do kolejnych kolumn w Excelu. I tak 500 razy, więc z oczywistych względów chcę to zautomatyzować. :-)

Wyszukuje informacje w Globalnej Liście Adresów, połączenie z serwerem MS Exchange (nie wiem czy to w ogóle istotne). Czasem mam dokładnie dopasowane nazwy, czasem brak części informacji. ALe przy użyciu przyciusku "sprawdź poprawność adresatów" (nie pamiętam dokładnie, standardowa przycisk przy tworzeniu nowej wiadomości) wszystkich wyszukuje bez wielokrotnych dopasowań.

A tak na marginesie... Excela uczyłem się nagrywając większość rzeczy i w t en sposób opanowują komendy w VBA. Tutaj takiej opcji nie ma. Możecie polecić jakiś kurs online lub książka, najlepiej uwzględniająca makra w outlooku jak i wykorzystanie outlooka przy makrach Excelowskich?

OShon · Wysłany: 2011-12-18, 11:14

Czyli chcesz adresy zawarte w książce dresowej przenieść do Excela.
Wg jakiejś listy zapisanej w Excelu, aby je dopasować, skąd te adresy masz pobrać?
czy całość adresów widocznych w danych folderze chcesz przenieść na arkusz?
może chcesz zaznaczyć kilka adresatów z książki adresowej (np wg grupy) i je przenieść?

Pytam bo twoja odpowiedź jest mało precyzyjna a możliwości mnóstwo.

Matuzam · EXCELent Man **Pomógł:** 20 razy Posty: 102

OShon · Wysłany: 2011-12-18, 16:07

Cytat:

Nie adresy, tylko wybrane pozycje z właściwości kontaktów

Niestety nie umiesz napisać sedna - ponieważ mając kolekcje 2000 adresów chcesz wyciągnąć 100 to co będzie elementem wyróżniającym - przypisanym do kontaktu.
Wszystko się da - ale pozostawmy to już bo chcesz śpiewać a seplenisz jak dzieciak.
Zainstaluj program do exportu danych w outlooku do pliku CSV CodeTwo Outlook Export

Matuzam · EXCELent Man **Pomógł:** 20 razy Posty: 102

Ech. Pierwsze zdanie w temacie. Mam listę imię i nazwisko i to jest jedyny wyznacznik. żadnego innego nie ma. instalacja czegokolwiek odpada... a informacje, które chcę wyciągnąć to stanowisko, dział i wszystkie nr telefonów, które są podane.

OShon · Wysłany: 2011-12-19, 10:10

Aby dopełnić to pow. zdanie to listę Imię Nazwisko masz razem - czy osobno (osobno imię osobno nazwisko)
Zapisane gdzie - w pliku XLS w komórkach, w pliku TXT (jak linia pod linią, czy z kwantyfikatorem) czy w bazie (jakiej bazie).
To są kluczowe informacje aby na tym oprzeć meritum kodu. Nie dziw się pytaniom bo założyłeś że to co masz przed oczyma będzie widział każdy. Co innego jak być załączył skrawek informacji poparte plikiem abo wyczerpująca odpowiedzią.
Program nie jest wróżką - musisz być precyzyjny.

Matuzam · EXCELent Man **Pomógł:** 20 razy Posty: 102

Nie dziwię się, po prostu nie wiem co Ci jest potrzebne. A tak między bogiem a prawdą, to mogę mieć to dowolnie zapisane, w excelu w miarę umiem się poruszać o łączenie/rozdzielenie imienia i nazwiska to nie fizyka kwantowa. A teraz konkretne odpowiedzi na konkretne pytania:

W pliku *.xls, kolumna A poczynając od A2. W komórka wpisane w kolejności nazwisko i imię, czasem po nazwisku i imieniu dane firmy (w identycznej formie jak w OUTLOOKU)

A2 = Kowalski Jan
A3 = Nowak Sławomir
A4 = Brzęczyszczykiewicz Grzegorz (FIRMA ABC)

W A4 przykład dokładnej nazwy wyświetlanej (nie wiem jak dokładnie się to nazywa) z globalnej listy kontaktów.

Albercik777 · Excel Expert **Pomógł:** 291 razy Posty: 616

Matuzam, niestety muszę się zgodzić z OShonem, że nie podajesz dokładnych instrukcji.
Ale ponieważ napisałeś:

OShon · Wysłany: 2011-12-19, 13:47

Ok skoro kolega Albercik777, podał nam jak to się robi w Exchange, to aby uzupełnić informacje ja pokażę jak to zrobić w książce adresowej Outlooka. Za wyświetlenie danych identyfikujących kontakt odpowiada parę pól - są to inne pola niż w Exchange.
Jednym z nich może być pole agregujące, nazywane potocznie "nazwą wyświetlaną" = LastNameAndFirstName. ale jest to inne pole niż LastName & " " & FirstName (tak dla utrudnienia).

Problem polega na tym że jeśli byśmy mieli do czynienia z adresem email to nie będzie w nim mowy o pomyłce (nie pasujący - będzie to inny adres).

Poniżej podaje ci kod dla lokalnej książki adresowej:

Kod:

Sub outlook_contacts()
Dim komorka As Range, zakres As Range, x&
Set zakres = Range("a2:a" & Cells(Rows.Count, "a").End(xlUp).Row)

Dim olApp As Object 'New Outlook.Application
Set olApp = CreateObject("Outlook.Application")
Dim oFolder As Object 'Outlook.MAPIFolder
Dim oKontakt As Object 'Outlook.ContactItem
Const olFolderContacts = 10
Set oFolder = olApp.GetNamespace("MAPI").GetDefaultFolder(olFolderContacts)

Application.ScreenUpdating = False
For Each komorka In zakres
'DoEvents 'tutaj możemy dodać info do paska postępu
For x = 1 To oFolder.Items.Count
If oFolder.Items(x).Class = 40 Then
Set oKontakt = oFolder.Items(x)
With oKontakt
'Debug.Print oKontakt.FullName
If LCase(.LastName) & " " & LCase(.FirstName) = LCase(komorka.Value) Or _
LCase(.FirstName) & " " & LCase(.LastName) = LCase(komorka.Value) Or _
LCase(.FileAs) = LCase(komorka.Value) Then
komorka.Offset(0, 1) = .JobTitle
komorka.Offset(0, 2) = .Email1Address
komorka.Offset(0, 3) = CStr(.MobileTelephoneNumber)
komorka.Offset(0, 4) = CStr(.PrimaryTelephoneNumber)
komorka.Offset(0, 5) = .CompanyName
komorka.Offset(0, 6) = .BusinessAddress
Exit For
End If
End With
End If
Next
Next komorka
Set zakres = Nothing
Set oFolder = Nothing
Set olApp = Nothing
Application.ScreenUpdating = True
Beep
End Sub

Albercik777 · Excel Expert **Pomógł:** 291 razy Posty: 616

To jeszcze prześlę zmieniony/poprawiony kodzik.
W poprzednim dla każdego wyszukiwanego kontaktu przeszukiwana była książka (exchange) od początku, tym samym wielokrotne były te same kontakty.
Poniżej przykład rozwiązania z jedynokrotnym przeszukaniem danych w outlook dla wszystkich poszukiwanych danych.
Różnica w czasie wyszukiwania pomiędzy poprzednim makrem a tym poniżej powinna rosnąć wprost proporcjonalnie do ilości wyszukiwanych danych ;-)

Kod:

Sub outlook_contacts()
Dim komorka As Variant
Dim zakres As Range
Dim kontakt As AddressEntry
Dim dane()
Dim i As Long, j As Long

Do

On Error Resume Next
Set zakres = Nothing
Set zakres = Application.InputBox(Prompt:="zaznacz listę osób", Title:="Zakres z kontaktwami", Type:=8)
If zakres Is Nothing Then Exit Sub
On Error GoTo 0

If zakres.Columns.Count > 1 Then _
MsgBox Prompt:="Zaznacz tylko jedną kolumnę", Title:="błąd danych", Buttons:=vbOKOnly

Loop While zakres.Columns.Count > 1

If Not zakres.Parent.AutoFilter Is Nothing Then
zakres.CurrentRegion.AutoFilter
End If
zakres.CurrentRegion.AutoFilter
zakres.Parent.AutoFilter.Sort.SortFields.Clear
zakres.Parent.AutoFilter.Sort.SortFields.Add Key:=zakres, SortOn:=xlSortOnValues
zakres.Parent.AutoFilter.Sort.Apply

dane = zakres
ReDim Preserve dane(1 To zakres.Rows.Count, 1 To 8)
dane = Kontaktydotablicy(dane())

Application.ScreenUpdating = False
For i = 1 To zakres.Rows.Count
For j = 1 To UBound(dane, 2) - 1
zakres.Cells(i).Offset(0, j) = dane(i, j + 1)
Next j
Next i
Application.ScreenUpdating = True
End Sub

Function Kontaktydotablicy(ByRef dane())
Dim olApp As New Outlook.Application
Dim olNSp As Outlook.Namespace
Dim oAL As Outlook.AddressList
Dim colAE As Outlook.AddressEntries
Dim oAE As Outlook.AddressEntry
Dim znajdzdane As AddressEntry

Set olNSp = olApp.GetNamespace("MAPI")
Set oAL = olNSp.AddressLists("Globalna Lista Adresów")
Set colAE = oAL.AddressEntries

Dim max As Long
Dim i As Long
i = 1
max = UBound(dane, 1)

For Each oAE In colAE
If oAE.AddressEntryUserType = olExchangeUserAddressEntry _
Or oAE.AddressEntryUserType = olExchangeRemoteUserAddressEntry Then

If StrComp(oAE.name, dane(i, 1), vbTextCompare) = 1 Then i = i + 1
If LCase(oAE.name) = LCase(dane(i, 1)) Then
Set znajdzdane = oAE.GetExchangeUser
dane(i, 2) = znajdzdane.JobTitle
dane(i, 3) = znajdzdane.PrimarySmtpAddress
dane(i, 4) = CStr(znajdzdane.BusinessTelephoneNumber)
dane(i, 5) = CStr(znajdzdane.MobileTelephoneNumber)
dane(i, 6) = znajdzdane.CompanyName
dane(i, 7) = znajdzdane.StreetAddress & " " & znajdzdane.City
dane(i, 8) = znajdzdane.Alias
i = i + 1
End If

End If
If i > max Then Exit For
Next oAE

Kontaktydotablicy = dane
Set olNSp = Nothing
Set oAL = Nothing
Set colAE = Nothing

End Function

Matuzam · EXCELent Man **Pomógł:** 20 razy Posty: 102

Jako że pobierania danych z outlook powróciła, to ja odgrzebuję temat...

Przy makrze Albercik777 wyskakuje błąd: Automation Error na linii Next oAE. Ale wyskakuje w różych miejscach, przy różnych kontaktach. :shock:

Przy próbie wznowienia pracy makra jest błąd: For loop not initialized....