VBATools

Hurtowa zamiana domen w adresach email

by on Jun.22, 2010, under Outlook, Porady

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.

Option Explicit
Sub zamiana_domen()
'MVP OShon from VBATools.pl
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
Set oContact = Nothing
Set 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. Przykładowe 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 na Outlook.pl.

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

:, , ,

Leave a Reply

Recently Active Members

Profile picture of vbatools
Profile picture of Joanna Subik
Profile picture of Karol Stilger
Profile picture of Anorak
Profile picture of marcinmachalowski
Profile picture of programistaaccess
Profile picture of piotrpawlik
Profile picture of Emil Wasilewski
Profile picture of kicekpicek
Profile picture of coldfusion
Profile picture of Gosia Borzęcka
Profile picture of lukaszch
Profile picture of itadministracja
Profile picture of farbenia
Profile picture of Łukasz Kałużny
Profile picture of kabzinski
Profile picture of rtynski
Profile picture of leszekbetlinski
Profile picture of Iv
Profile picture of Justyna Spychała