1

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 からのメールを選択した場合、取得できるようにしたい

\server\homedirectory\jimmy

変数として「ジミー」を使用します。これが可能であれば、どんな助けでも大歓迎です。

ここに画像の説明を入力

4

1 に答える 1

0

フォローコードは機能します

 

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
于 2012-04-25T13:48:59.293 に答える