Microsoft Outlook troubleshooting

W niektórych przypadkach zachodzi konieczność zmiany domeny w istniejących kontaktach Outlooka. Podyktowane jest to np. migracją pracowników pod skrzydła innej firmy, bądź rejestracją nowej domeny. Wyszukiwanie i edytowanie wszystkich adresów ręcznie (np. z odbiorca@abc.com.pl na odbiorca@nowa_nazwa.pl) spędza sen z powiek. Brak takiej modyfikacji może po wygaśnięciu warunków przekierowania wiadomości ze starej domeny spowodować, iż nasza poczta nie trafi do adresata.

Poniższa procedura uruchamia dwa okna, w których należy wpisać część adresu po znaku @ (domenę do zmiany) oraz domenę, na jaką adresy mają być zamienione. 

 

Sub zamiana_domen()
    Dim oContact As ContactItem
    Dim oContactFolder As MAPIFolder
    Dim x&, item As Object, msg$, Stara_domena$, Nowa_domena$, Message$

    Message = "Podaj nazwę domeny do zamiany." & vbCr & vbCr _
            & "Domena to wartośc znajdujaca się po znaku @ adresie Email."
    Stara_domena = InputBox(Message, "Zamiana domen w adresach email. Krok 1/2")
    Message = "Podaj nazwę nowej domeny, na którą będzie zmianiona: " & Stara_domena & vbCr & vbCr _
            & "Domena to wartośc znajdujaca się po znaku @ adresie Email."
    Nowa_domena = InputBox(Message, "Zamiana domen w adresach email. Krok  2/2")

    If Len(Stara_domena) = 0 Or Len(Nowa_domena) = 0 Then GoTo koniec
    On Error GoTo blad

    'procedura uwzględnia domyślny katalog folderów
    Set oContactFolder = Application.GetNamespace("MAPI").GetDefaultFolder(olFolderContacts)
    For x = 1 To oContactFolder.Items.Count
        If oContactFolder.Items(x).Class <> 40 Then GoTo nastepny
        Set oContact = oContactFolder.Items(x)
        DoEvents
        If Not oContact Is Nothing Then
            With oContact
                If .Email1Address Like "*" & Trim(Stara_domena) & "*" Or _
                   .Email1Address Like "*" & Trim(Stara_domena) Then
                    .Email1Address = Split(.Email1Address, "@")(0) & "@" & Trim(Nowa_domena)
                    msg = msg & .FullName & " -> adres zamieniamy z: " & .Email1Address & " -> na: " & _
                                Split(.Email1Address, "@")(0) & "@" & Trim(Nowa_domena) & vbCr
                    .Save
                End If
            End With
        End If
nastepny:
    Next
    If Len(msg) = 0 Then
        MsgBox "Brak adresów spełniających warunek" & vbCr _
            & Stara_domena & " -> " & Nowa_domena, vbInformation, "Procedura ''Zamiana domen''"
    Else
        MsgBox msg, vbInformation, "Procedura ''Zamiana domen''"
    End If
    oContact = Nothing
    oContactFolder = Nothing
    Exit Sub
koniec:
    MsgBox "Nie podano wymaganych parametrów procedury" & vbCr _
         & "Proces zamiany domen został anulowany", vbExclamation, " Informacja o błędzie"
    Exit Sub

blad:
    MsgBox "Błąd procedury: ''zamiana_domen''" & vbCr _
         & Err.Number & vbCr _
         & Err.Description, vbExclamation, " Informacja o błędzie"
End Sub

 

Aby osadzić procedurę „zamiana_domen” pod przyciskiem w menu MS Outlook, polecam uwadze ten artykuł.

Postępowanie krokowe w makro:

  • sprawdza, czy podano starą i nowa domenę
  • przeszukuje domyślny folder kontaktów w poszukiwaniu starej domeny
  • zamienia domeny i zapisuje kontakt, bez modyfikacji innych danych w kontakcie
  • po zakończeniu procedury informuje o przebiegu procesu

Makro nie zamienia adresów w listach dystrybucyjnych (dot. tylko kontaktów).

Aplikację można rozszerzyć budując interfejs w developerze języka VBA, dodając np. tekstowe okienka i przypisując do nich zmienne odpowiadające pierwotnie komendzie InputBox zawartej w powyższej procedurze, usuwając linie wywołania komunikatów.

Okno wyświetlone po uruchomieniu procedury.

Rys. 1. Okno wyświetlone po uruchomieniu procedury.

Posiadając listę adresów w pliku tekstowym, możemy też przeprowadzić zamianę każdego adresu z osobna. Więcej o tym w tym wątku.

MVP Shon Oskar – VBATools.pl
Jeśli masz pytania dot. tego artykułu zapraszam na Forum
Skonfiguruj swój pakiet dodatków do Excela, Worda, PowerPointa i Outlooka



© Wszelkie prawa zastrzeżone. Żadna część ani całość tego artykułu nie może być powielana ani publikowana bez zgody autora.