VBA Outlook 2010 Active Directoryから情報を取得する

Question

Outlook 2010でVBAを使用していますが、Active Directoryから選択したユーザーのホームフォルダパスを取得する機能を作成しようとしています。

次のコードは、保存先を持つ単純なポップアップです。

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 

現在選択されている電子メールに応じて、VARIABLEがADから来るようにします。例えば
は私がJimmy@home.comからメールを受け取った後、私はjimmy@home.comからの電子メールを選択し、私が取得することができるようにしたい

\サーバー\はHomeDirectoryの\ジミー

と "jimmy"を私のVARIABLEとして使用してください。 可能であれば、どんな助けでも大歓迎です。

Answer 1

次のコードが動作

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