Hjälp med VB-script för Outlook

Trädvy Permalänk
Medlem
Plats
Stockholm
Registrerad
Dec 2001

Hjälp med VB-script för Outlook

Har hittat ett script som automatiskt skapar kontakter från ett gäng markerade e-postar. Men den har ett steg på slutet som frågar om man vill skriva över kontakten om kontakten redan finns.

Jag behöver ändra det steget så att den fortsätter automatiskt utan att fråga och bara hoppar över den kontakten om den redan finns i kontaktlistan.

Så här ser skriptet ut:
' The AddAddressesToContacts procedure can go in any Module
' Select the mail folder and any items to add to contacts, then run the macro

Public Sub AddAddressesToContacts()
Dim folContacts As Outlook.MAPIFolder
Dim colItems As Outlook.Items
Dim oContact As Outlook.ContactItem
Dim oMail As Outlook.MailItem
Dim obj As Object
Dim oNS As Outlook.NameSpace

Dim response As VbMsgBoxResult

Dim bContinue As Boolean

Dim sSenderName As String

On Error Resume Next

Set oNS = Application.GetNamespace("MAPI")
Set folContacts = oNS.GetDefaultFolder(olFolderContacts)
Set colItems = folContacts.Items

For Each obj In Application.ActiveExplorer.Selection
If obj.Class = olMail Then
Set oContact = Nothing

bContinue = True
sSenderName = ""

Set oMail = obj

sSenderName = oMail.SentOnBehalfOfName
If sSenderName = ";" Then
sSenderName = oMail.SenderName
End If

Set oContact = colItems.Find("[FullName] = '" & sSenderName & "'")

If Not (oContact Is Nothing) Then
response = MsgBox("This appears to be an existing contact: " & sSenderName & ". Do you still want to add it as a new contact?", vbQuestion + vbYesNo, "Contact Adder")
If response = vbNo Then
bContinue = False
End If
End If

If bContinue Then
Set oContact = colItems.Add(olContactItem)
With oContact
.Body = oMail.Subject

.Email1Address = oMail.SenderEmailAddress
.Email1DisplayName = sSenderName
.Email1AddressType = oMail.SenderEmailType

.FullName = oMail.SenderName

.Save
End With
End If
End If
Next

Set folContacts = Nothing
Set colItems = Nothing
Set oContact = Nothing
Set oMail = Nothing
Set obj = Nothing
Set oNS = Nothing
End Sub

Har markerat det jag vill ändra i tjock text, kan inte sånt här alls så nån får gärna hjälpa mig

|ASUS Z170-A||6700K@4.6Ghz||Corsair H50 Scythe GT 1450RPM PnP||16GB Crucial DDR4 2133Mhz@2800Mhz||Gigabyte GTX 970||850EVO 500GB||Corsair HX 1050W||Fractal Design - Define R2 Black Pearl|Citera för svar
Fotoblogg: PlanetStockholm

Trädvy Permalänk
Medlem
Registrerad
Jan 2003

Är det inte bara rader några rader så det blir

If Not (oContact Is Nothing) Then bContinue = False End If