Outlook namen contactpersonen herkennen

Status
Niet open voor verdere reacties.
A

Axel05

Gebruiker
Lid geworden
12 nov 2014
Berichten
30
Hoi,

Ik gebruik momenteel een sub die een gedeelte van een contactpersoon bevat, waardoor deze herkent wordt bij het versturen. Echter wil ik het andere gedeelte van de naam van de contactpersoon in het subject van de mail naar voren laten komen. Nu is het probleem dat de namen pas bij het daadwerkelijk versturen herkent worden en de sub deze dus niet oppakt. Een simpel voorbeeld:

Contactpersoon = 123 ABC
.to = 123
.subject = Right( contactpersoon, 3) zou moeten zijn = ABC

De eerste twee gaan goed, echter worden de namen niet herkent waardoor de sub enkel met 123 kan werken..

Kan ik dit oplossen door bijvoorbeeld de sub de namen te laten herkennen? Of kan ik op een andere manier mijn contactpersonen matchen?

Alvast bedankt!

Axel
 
Dat is weer zo specifiek dat je beter even je hele Sub kan plaatsen. De code die je als voorbeeld hebt geplaatst zou sowieso niet goed gaan.
 
Laatst bewerkt:
Hoe ziet de gehele sub eruit.
 
Doordat de .To natuurlijk pas geladen wordt na de sub, werkt die niet.. Hoe kan ik deze load tijdens de sub doen? Handmatig namen herkennen werkt perfect.

PS, de contactgroep heet "123 AB"" en wordt succesvol gevonden met 123..

Code: 
 Sub Axel()

Dim objMsg As MailItem
Set objMsg = Application.CreateItem(olMailItem)

strTo = "123"

With objMsg
    
    
    .To strTo
    .Subject = Right(.To, 2)
    
    .Display
    
    
    End With
    

End Sub
 
Laatst bewerkt:
In die code is nergens de string "123 AB" terug te vinden. Als je dat daar niet hebt kan je dat er ook niet uit halen.
 
Laatst bewerkt:
Dat is ook het hele punt.. Namen herkennen binnen de sub is niet mogelijk? Als ik dit handmatig doe pakt hij de juiste contactpersoon en kan hij daarna wel het subject correct vullen.
 
Dat doet de Sub niet, dat doet Outlook zelf.
 
Dat snap ik, vraag dus of dit wel binnen een sub mogelijk is? Alternatief zou natuurlijk twee losse subs zijn, maar als het binnen 1 kan heeft dat sowieso voorkeur.
 
Ik ben met bovenstaande link aan de slag gegaan, wat zeer helpvol was. Nu heb ik een sub in elkaar geflanst die alle members van een lijst die ik benoem langsgaat en benoemt met een MsgBox. Echter kan werkt dit enkel als ik de gehele naam - dus "123 Ax" - type en niet als ik enkel "123*" in geef.. Wie kan me verder op weg helpen?

Code: 
Sub test()
' adapted from http://www.slovaktech.com/code_samples.htm#DLToWord
' writes dist list members to a worksheet, one row for each contact in dist list
 
' get reference to Outlook contacts folder
Dim olApp As Outlook.Application
Dim olNS As Outlook.NameSpace
Dim olContactsFolder As Outlook.Items
 
Set olApp = Outlook.Application
Set olNS = olApp.GetNamespace("MAPI")
Set olContactsFolder = olNS.GetDefaultFolder(olFolderContacts).Items
 

' find specific dist list
Dim olDistList As Outlook.DistListItem
Set olDistList = olContactsFolder[B][COLOR="#FF0000"]("123*")[/COLOR][/B]

 
 Dim lMemberCount As Long
lMemberCount = olDistList.MemberCount
 
' create temp variant and set size to one row for each contact
Dim tempVar As Variant
ReDim tempVar(1 To lMemberCount, 1 To 2)

 
 Dim i As Long
Dim objRecip As Outlook.Recipient
For i = 1 To lMemberCount
  ' no Object Model Guard!
  Set objRecip = olDistList.GetMember(i)
  tempVar(i, 1) = objRecip.Name
  tempVar(i, 2) = objRecip.Address

MsgBox objRecip
Next i
 

 
If olDistList Is Nothing Then Exit Sub

End Sub
 
Ik heb het anders opgelost. Heb mijn contactgroepen ingericht als 123 en de AB verwerkt in de contactnaam, op deze manier kan ik hem ophalen met bovenstaande sub. Bedankt voor de hulp!
 
Nog een vraag.. Ik krijg de namen perfect naar boven vanuit de exchange server met onderstaande code. Echter kan het ook voorkomen dat de contactgroep niet bestaat, en dus nog aangemaakt dient te worden. Momenteel geeft de sub dan een foutmelding en doet niets. Ik wil hier een MsgBox op laten komen met 'sendTo' en vervolgens verder gaan met de sub op het gedeelte van het opzoeken van de contactpersoon na.

Een stuk van de code:
Code: 
Dim olApp As Outlook.Application
Dim olNS As Outlook.NameSpace
Dim newContactFolder As Outlook.Items
 
Set olApp = Outlook.Application
Set olNS = olApp.GetNamespace("MAPI")
sendTo = "C" & Mid(FileName, 6, InStr(6, FileName, "-") - 6)


Dim NS As Outlook.NameSpace
Dim objOwner As Outlook.Recipient
    Set NS = Application.GetNamespace("MAPI")
        Set objOwner = NS.CreateRecipient("Axel05")
    objOwner.Resolve

Set newContactFolder = NS.GetSharedDefaultFolder(objOwner, olFolderContacts).Items


' find specific dist list
Dim olDistList As Outlook.DistListItem

If newContactFolder(sendTo) Is Nothing Then MsgBox sendTo & " is not not created in outlook contacts"
Else
Set olDistList = newContactFolder(sendTo)

Nu geeft VBA de volgende foutmelding bij een niet bestaande contactpersoon:

newContactFolder(s... = < The attempted operation failed. an object could not be found.
Klik om te vergroten...

Mijn if Is Nothing werkt hierbij niet.. Hij doet dan namelijk helemaal niets. Wat moet ik gebruiken om deze foutmelding the omzeilen en de MsgBox te creeren indien onbekend, en door te gaan indien wel bekend?
 
Heb het gefixt met een Error Handler die de MsgBox geeft.
 
Misschien toch te vroeg gejuicht, heb met onderstaande errorhandler de MsgBox geregeld. Echter sluit deze de gehele sub. Is er een manier om enkel dit item uit de loop te excluden, de MsgBox te tonen en vervolgens de loop te vervolgen?

Code: 
ExitSub:
    Exit Sub

Errhandler:

MsgBox sendTo & " is not not created in outlook contacts"
Resume ExitSub
 
Laatst bewerkt:
Probeer het eens met Resume Next i.p.v. Resume ExitSub
 
Thanks, dat werkt inderdaad. Hij volgt alleen wel de hele sub voor deze items, waardoor die ze ook verplaatst etc. Kan ik dit op de een of andere manier tegengaan?

Mijn loop eindigt met :
Code: 
   FileName = Dir()
Loop

Kan ik met een soortgelijke code in de ErrorHandler de loop eerder triggeren om door te gaan met het volgende item?
 
Als FileName leeg is zal je zal je door willen gaan neem ik aan. Hoe ziet de start van je Loop eruit?
 
Bedankt voor de hulp edmoor. De sub is redelijk simpel opgebouwd met onderstaande logica. Hij gaat alle PDF bestanden in een bepaalde map langs en creeert een e-mail per PDF bestand. Wat de bedoeling is, is dat indien het e-mail adres onbekend is deze een MsgBox geeft en vervolgens verder gaat met de volgende PDF in de loop:

Code: 
Sub tLoop()

Dim Strpath As String
Strpath = "C:\Desktop"

Path = Strpath & "\*.PDF"
FileName = Dir(Path)


Do Until FileName = ""
  Count = Count + 1


MsgBox FileName


   FileName = Dir()
Loop


End Sub
 
Ik heb het opgelost door middel van Select Case. Doordat een error de strBody rule overslaat kan deze gebruikt worden om te excluden uit de loop. Deze case ziet er als volgt uit:

Code: 
Case "I"

strBody = "Dear All, <br><br>Attached you will find " & Mid(objRecip, 2, InStr(1, objRecip, "-") - 2) 

If strBody = "" Then

MsgBox  sendTo & " is not created correctly"
        
Else

With objMsg
        .Display
        .SentOnBehalfOfName = "Axel05@mail.com"
        .To = sendTo
        '.Attachments.Add "C:\Desktop\" & FileName
        .Attachments.Add Strpath & FileName
        .Subject = "Subject"
        .HTMLBody = strBody & "<br>" & .HTMLBody
        .Display
        

        '.Send
        '.Save
        '.Close olPromtForSave
        
End With

sSourcepath = Strpath & FileName
sDestinationPath = "C:\Dektop\" & FileName


Set objFSO = CreateObject("scripting.filesystemobject")

  objFSO.MoveFile Source:=sSourcepath, _
                        Destination:=sDestinationPath
                        
End If

Werkt precies zoals ik hem wil hebben, een MsgBox wanneer de Contactpersoon niet bestaat of incorrect is en een mail wanneer alles naar behoren is!


Toevoeging, de exclude komt uiteraard van onderstaande code. Daar de case niet aan voorwaarde "I" voldoet.

Code: 
Case Other
MsgBox  sendTo & " is not created correctly"

End Select
 
Laatst bewerkt:
Status
Niet open voor verdere reacties.
                    Steun ons                    

Nieuwste berichten

Terug
Bovenaan Onderaan