Outlook + emailadr.

Hej Alle.

Jeg har oprettet nedestående kode.
Koden skal indsætte en fiktiv e-mailadresse hvor der ikke findes e-mailadresse.
For - Next løkken løber fint igennem men den fiktive E-mailadresse B@B.dk bliver ikke gemt

HJÆLP

Hilsen JBjerre
________________________________________________________

Option Explicit

Private Sub Application_Startup()
On Error Resume Next
Dim OutlookApp As New Outlook.Application
Dim ContactFolder As MAPIFolder
Dim i As Integer

Set ContactFolder = OutlookApp.GetNamespace("MAPI").GetDefaultFolder(olFolderContacts)

    For i = 1 To ContactFolder.Items.Count - 1
            If ContactFolder.Items(i).Email1Address = "" Then
                MsgBox ContactFolder.Items(i).FirstName & " " & ContactFolder.Items(i).Email1Address
                ContactFolder.Items(i).Email1Address = "B@B.dk"
                ContactFolder.Items(i).Save
            End If
    Next

Set ContactFolder = Nothing

End Sub