06. september 2006 - 10:45Der er
5 kommentarer og 1 løsning
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
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
Har modificeret koden - men nu virker det - erafprøvet fra Word 2003-VBA:
Private Sub Application_Startup() On Error Resume Next Dim OutlookApp As New Outlook.Application, olapp, namespace Dim cfold As MAPIFolder Dim i As Integer Dim myInspector As Outlook.Inspector
Set olapp = CreateObject("Outlook.Application") Set namespace = olapp.GetNamespace("MAPI")
rem Min test-folder Set afold = namespace.Folders 'alle mapper Set bfold = afold.Item("Postkasse - PB Peter Braagaard-Sørensen") Set cfold = bfold.Folders("Kontaktpersoner")
For i = 1 To cfold.Items.Count Set myInspector = cfold.Items(i).GetInspector mail = myInspector.CurrentItem.Email1Address If mail = "" Then myInspector.CurrentItem.Email1Address = "B@B.dk" myInspector.CurrentItem.Save End If Next
Du har vel korrigeret disse linier: Set afold = namespace.Folders 'alle mapper Set bfold = afold.Item("Postkasse - PB Peter Braagaard-Sørensen") Set cfold = bfold.Folders("Kontaktpersoner")
Således - er testet og fungerer så vidt jeg kan se
Private Sub Application_Startup() On Error Resume Next Dim OutlookApp As New Outlook.Application, olapp, namespace Dim cfold As MAPIFolder Dim i As Integer Dim myInspector As Outlook.Inspector
Set cfold = OutlookApp.GetNamespace("MAPI").GetDefaultFolder(olFolderContacts)
antal = cfold.Items.Count
For i = 1 To cfold.Items.Count Set myInspector = cfold.Items(i).GetInspector mail = myInspector.CurrentItem.Email1Address If mail = "" Then myInspector.CurrentItem.Email1Address = "B@B.dk" myInspector.CurrentItem.Save End If Next
Tilladte BB-code-tags: [b]fed[/b] [i]kursiv[/i] [u]understreget[/u] Web- og emailadresser omdannes automatisk til links. Der sættes "nofollow" på alle links.
