VBA Outlook 2010 récupération d'informations à partir d'Active Directory

Question

J'utilise VBA dans Outlook 2010 et j'essaie de créer une fonction qui récupère un chemin d'accès de dossier d'utilisateur sélectionné à partir d'Active Directory.

Le code suivant est une simple fenêtre contextuelle contenant la destination d'enregistrement.

Sub SaveSelected() 
'Declaration 
Dim myItems, myItem, myAttachments, myAttachment 
Dim myOrt As String 
Dim myOLApp As New Outlook.Application 
Dim myOlExp As Outlook.Explorer 
Dim myOlSel As Outlook.Selection 
Dim objFSO As Object 
Dim intCount As Integer 

'Ask for destination folder 
myOrt = InputBox("Destination", "Save Attachments", "\\server\home\VARIABLE\") 
End Sub 

Je souhaite que la VARIABLE provienne de l'ANNONCE en fonction de l'e-mail actuellement sélectionné.
par exemple, je reçu un courriel de Jimmy@home.com puis-je sélectionner l'e-mail de jimmy@home.com, je veux être en mesure de récupérer

\ server \ homedirectory \ jimmy

et utilisez "jimmy" comme VARIABLE. Si cela est possible, toute aide serait grandement appréciée.

Answer 1

Le code de suivi fonctionne

Sub GetSelectedItems() 

 Dim myOlExp As Outlook.Explorer 
 Dim myOlSel As Outlook.Selection 
 Dim mySender As Outlook.AddressEntry 
 Dim oMail As Outlook.MailItem 
 Dim oAppt As Outlook.AppointmentItem 
 Dim oPA As Outlook.propertyAccessor 
 Dim strSenderID As String 
 Dim myOrt As String 
 Dim user As String 

 Const PR_SENT_REPRESENTING_ENTRYID As String ="http://schemas.microsoft.com/mapi/proptag/0x00410102" 

 Set myOlExp = Application.ActiveExplorer 
 Set myOlSel = myOlExp.Selection 


 For x = 1 To myOlSel.Count 
 If myOlSel.item(x).Class = OlObjectClass.olMail Then 
 ' For mail item, use the SenderName property. 
 Set oMail = myOlSel.item(x) 


 ElseIf myOlSel.item(x).Class = OlObjectClass.olAppointment Then 
 ' For appointment item, use the Organizer property. 
 Set oAppt = myOlSel.item(x) 

 Else 

 Set oPA = myOlSel.item(x).propertyAccessor 
 strSenderID = oPA.GetProperty(PR_SENT_REPRESENTING_ENTRYID) 
 Set mySender = Application.Session.GetAddressEntryFromID(strSenderID) 

 End If 
 Next x 


Set objConnection = CreateObject("ADODB.Connection") 
Set objCommand = CreateObject("ADODB.Command") 

objConnection.Open "Provider=ADsDSOObject;" 
objCommand.ActiveConnection = objConnection 

strDomainName = "ou=company,dc=mydc,dc=com" 
strUserCN = oMail.SenderName & "" 

objCommand.CommandText = "<LDAP://" & strDomainName & ">;(& 
(objectCategory=person)(objectClass=user)(cn=" & strUserCN & 
"));samAccountName;subtree" 

Set objRecordSet = objCommand.Execute 

If Not objRecordSet.EOF Then 

user = objRecordSet.Fields("samAccountName") 

myOrt = InputBox("Destination", "Save Attachments", "\\server\home\" &user & "") 


End If 

objConnection.Close 
Set objRecordSet = Nothing 
Set objConnection = Nothing 
Set objCommand = Nothing 

'free variables 
Set myItems = Nothing 
Set myItem = Nothing 
Set myAttachments = Nothing 
Set myAttachment = Nothing 
Set myOLApp = Nothing 
Set myOlExp = Nothing 
Set myOlSel = Nothing 
Set user = Nothing 

End Sub