Update Assign to field with Outlook vbs - vba

In the Outlook i have create a custom form in Task form. I use it to assign task to other users. Now i try to add some code when a user not fill the assign to field (for example if the task is for him to check it when save the task and ask him if need to add himself as assigned user. My problem is that i can't update the field assigned to if it's empty.I get the error My code is the following:
Sub Item_Write(ByVal Name)
Set objPage = Item.GetInspector.ModifiedFormPages("Assign Task")
Set objControl = objPage.Controls("RecipientControl1")
Set objControl2 = objPage.Controls("Textbox1")
Set objControl4 = objPage.Controls("Textbox4")
Set oMsg = Application.CreateItem(olMailItem)
Set objNS = oMsg.Session
MyValue= objControl2.Value
MyValue4= objControl4.Value
if MyValue= "" then
if Msgbox ("Task isn't assign to anybody. Do you want to assign yourself?", vbYesNo)=vbYes then
objControl.Value=objNS.CurrentUser.Name
End if
End if
End Sub

Finally i found the solution,
I use the event Item_Close and Outlook property name for Recipient control and not Control name in Vbs. Find below my code that is working and form not close until user assign the task someone.
Function Item_Close()
Set objPage = Item.GetInspector.ModifiedFormPages("Assign Task")
Set objControl = objPage.Controls("Textbox1")
Set objNS = Application.GetNamespace("MAPI")
Set objContro2 = objPage.Controls("Frame1")
assigned=objControl.Value
'Use always Outlook property names and not Control Properties(as RecipientControl in case)
if assigned= "" then
info =Msgbox ("The task is not assigned to a user. Do you want to assign yourself?", vbYesNo)
Select Case info
Case 6
'Use always Outlook property names and not Control Properties(as RecipientControl in case)
Set myAssignedTo = Item.Recipients.Add(objNS.CurrentUser.Name)
Me.Save
Case 7
MsgBox "You must Assign Task to a user before save it.", vbExclamation
Item_Close=False
Item.GetInspector.SetCurrentFormPage "Assign Task"
End Select
End if
End Function

Related

VBScript to create an outlook rule

I'm trying to create a vbscript that I can distribute so an outlook rule is created for each user that runs it.
I have some code (below), however I have since found I can't create a rule via VBS with Actions.Run ("VBA Code"). I need a rule so that whenever an email is received from "test#test.com" a msgbox is displayed that the user must click OK an.
Through my research it indicates that the VBA may somehow be able to be implemented in the VBS file, but I can't find much on it.
The VBA I want to run is:
Sub newmsg(item As Outlook.MailItem)
MsgBox "You have an urgent message: " & item.Subject
End Sub
and the VBS is:
'--> Create some constants
Const RULE_NAME = "Urgent Message" '<-- Edit the name of the rule
Const olRuleReceive = 0
'--> Create some variables
Dim olkApp, olkSes, olkCol, olkRul, olkCon, olkAct
'--> Connect to Outlook
Set olkApp = CreateObject("Outlook.Application")
Set olkSes = olkApp.GetNamespace("MAPI")
olkSes.Logon olkApp.DefaultProfileName
'--> Get the rules collection
Set olkCol = olkSes.DefaultStore.GetRules()
'--> Create a new receive rule
Set olkRul = olkCol.Create(RULE_NAME, olRuleReceive)
'--> Set the rule's condition to look for a specific word in the subject
Set olkCon = olkRul.Conditions.From
With olkCon
.Enabled = True
.Recipients.Add ("email address here")
.Recipients.ResolveAll
End With
'--> Set the rule's action
Set olkAct = olkRul.Actions.Run("Project1.newmsg")
With olkAct
.Enabled = True
End With
'--> Save the rule
olkCol.Save False
'--> Disconnect from Outlook
olkSes.Logoff
Set olkCon = Nothing
Set olkAct = Nothing
Set olkRul = Nothing
Set olkCol = Nothing
Set olkSes = Nothing
Set olkApp = Nothing
'--> Terminate the script
WScript.Quit
The only supported way to modify VBA projects is by developing an add-in for the VBA editor using the Visual Basic Extensibility interfaces.
If you need to create a rule that performs a custom action then I recommend you build an Outlook add-in that processes incoming email messages and does the action within your add-in's code, rather than relying on a VBA method that may or may not exist.

Outlook not displaying the latest email while automating

I am using the following code to retrieve and check an email, but outlook is returning the mail starting from 12/22, which is neither the latest nor the oldest, while on a co worker's machine its picking up the oldest mail.
Set oapp = CreateObject("Outlook.Application")
Set oMAPI = oapp.GetNamespace("MAPI")
Set oInbox = oMAPI.GetDefaultFolder(6)
oInbox.Display
Set oallmails = oInbox.Items
Set oreqemail = oallmails.GetFirst
For oTotalmail = 1 To oallmails.Count
ostringmatch = oreqemail.Subject
'Using regex function to match
'If MatchString(ostringmatch,"89554 Completed") Then
'End If
'Exit For
Set oreqemail = oallmails.GetNext
Next
Am I missing any outlook setting, as the code looks ok to me.
Thanks
To be sure that you get always the latest or oldest email in Outlook you need to use the Sort method of the Items class. It sorts the collection of items by the specified property. The index for the collection is reset to 1 upon completion of this method. The name of the property by which to sort, which may be enclosed in brackets, for example, "[CompanyName]".
Note, Sort only affects the order of items in a collection. It does not affect the order of items in an explorer view.
Set oapp = CreateObject("Outlook.Application")
Set oMAPI = oapp.GetNamespace("MAPI")
Set oInbox = oMAPI.GetDefaultFolder(6)
oInbox.Display
Set oallmails = oInbox.Items
oallmails.Sort "[RecievedTime]"
Set oreqemail = oallmails.GetFirst
For oTotalmail = 1 To oallmails.Count
ostringmatch = oreqemail.Subject
'Using regex function to match
'If MatchString(ostringmatch,"89554 Completed") Then
'End If
'Exit For
Set oreqemail = oallmails.GetNext
Next
See Outlook VBA: How to sort emails by date and open the latest email found? for more information.

ActiveExplorer/Inspector selecting more than one item

I'm trying to tell Outlook to select only one mail item, but it appears to be selecting multiple (The internal program I'm sending it to is referencing "These documents" rather than "this document"). Because of that, it's not letting me choose a file type and I believe it's because the program is interpreting the file as a container instead of a file. tl;dr: Can anyone see anything in my code that would be allowing Outlook to select more than one mail item?
Dim objApp As Outlook.Application
Set objApp = Application
Select Case TypeName(objApp.ActiveWindow)
Case "Explorer"
If objApp.ActiveExplorer.Selection.Count > 0 Then
Set currentItem = objApp.ActiveExplorer.Selection.Item(1)
Else
MsgBox ("No Message Selected.")
Exit Sub
End If
Case "Inspector"
Set currentItem = objApp.ActiveInspector.currentItem
Case Else
MsgBox ("Please select a mail item.")
Exit Sub
End Select
Looks like you need to iterate over all items selected in the Explorer window:
Set currentItem = objApp.ActiveExplorer.Selection.Item(i)
For example:
For i = 1 To oSel.Count ' Loop through all the currently .selected items
Set oItem = oSel.Item(i) ' Get a selected item.
Next i
Take a look at the How To Get the Currently Selected Item in an Outlook Folder from Visual Basic article for the sample code.
Also I'd suggest breaking the chain of calls and declaring each property or method call on a separate line of code.

Outlook GAL fails to be top-most window when called from VBA UserForm

i have about ten responses from StackOverflow open but none of them quite answer my problem.
i have created several UserForms in Excel VBA for this particular project. (Note: i have no formal training on VBA programming and everything i have done is self-taught or gleaned from copying other people's codes.) While interfacing with more than one of these forms, i want the user to be able to access a command to select a user-name from the company's Global Address List. With a command button on the form and the following function i am able to do this:
Public Function GetUsernameFromOutlook(sCap As String) As String
'fancy code to call Outlook dialog box to select names.
'Badresult is the default, gives username of operator if they try to:
' select more than one recipient
' cancel out of the dialog box
Dim olApp As Object ' Outlook.Application
Dim olDialog As Object ' Outlook.SelectNamesDialog
Dim hwnd As Long
Set olApp = CreateObject("Outlook.Application")
Set olDialog = olApp.Session.GetSelectNamesDialog
With olDialog
.Caption = sCap
.ForceResolution = True
.AllowMultipleSelection = False
.NumberOfRecipientSelectors = olShowTo
.ToLabel = "Select User"
If .Display = False Then GoTo BadResult
SetForegroundWindow (Excel.Application.hwnd)
If .Recipients.Count <> 1 Then GoTo BadResult
'Debug.Print .Recipients(1).Name
'Debug.Print .Recipients(1).Address
'Debug.Print .Recipients(1).AddressEntry.GetExchangeUser.Alias
GetUsernameFromOutlook = .Recipients.Item(1).AddressEntry.GetExchangeUser.Alias
End With
' hwnd = FindWindow(vbNullString, sCap & ": Global Address List")
Set olApp = Nothing
Set olDialog = Nothing
Exit Function
BadResult:
SetForegroundWindow (Excel.Application.hwnd)
GetUsernameFromOutlook = Environ("UserName")
End Function
As you can see i attempted to use the SetForegroundWindow and FindWindow API calls as suggested in other answers. But the code doesn't even reach these lines before causing the problem.
The line If .Display = False brings up the SelectNamesDialog box from Outlook, but because my UserForm is modal (i think), it stays as the visible window. i am forced to use Alt-Tab to switch to Outlook. Then, after either selecting a name or cancelling out of the Outlook dialog box, i need to Alt-Tab again to get back to Excel.
Also, because the code is waiting for a response from the Outlook box, there is no further code execution, so SetForegroundWindow doesn't even happen until i complete all of the Alt-Tab switching.
Other solutions posted have referred to using calls to MSWord, or looking up information from or saving to a spreadsheet. i'm trying to use this call to modify the caption or text of a form control, such as a command button or text box or text label. i only need to collect the Outlook alias, since i have another function which can collect other selected information from Outlook based on the alias, so the alias is saved in a tag (unseen) on the form and converted to full name, initials or e-mail address as needed using this other function.
So far everything works great and i'd really like to release this interface to my beta-testers, but i don't want to have to explain to everyone to use Alt-Tab after they click the "select name" button. They will believe their computer has locked up and do a hard re-start. (Or call IT who will start asking questions that they cannot answer.)
i'm sorry that this question is so long, but i wanted to include as much information as possible. i'm sure there will be things i need to clarify, so please send me your questions in a response and i will do my best to explain better. Thank you for your time.
I just spent an evening on this, so even if this thread is one year old it should help.
You should just try using:
"olApp.ActiveWindow.Activate"
It sums up to this fully working function:
enter Public Function GetUsernameFromOutlook(sCap As String) As String
'fancy code to call Outlook dialog box to select names.
'Badresult is the default, gives username of operator if they try to:
' select more than one recipient
' cancel out of the dialog box
Dim olApp As Outlook.Application ' Outlook.Application
Dim olDialog As Outlook.SelectNamesDialog
Dim hwnd As Long
Set olApp = New Outlook.Application
Set olDialog = olApp.Session.GetSelectNamesDialog
'Set olDialog = new Outlook.Application
With olDialog
.Caption = sCap
'.ForceResolution = True
.AllowMultipleSelection = False
.NumberOfRecipientSelectors = olShowTo
.ToLabel = "Select User"
olApp.ActiveWindow.Activate
.display
If .Recipients.Count <> 1 Then GoTo BadResult
'Debug.Print .Recipients(1).Name
'Debug.Print .Recipients(1).Address
'Debug.Print .Recipients(1).AddressEntry.GetExchangeUser.Alias
GetUsernameFromOutlook = .Recipients.Item(1).AddressEntry
End With
Set olApp = Nothing
Set olDialog = Nothing
Exit Function
BadResult:
GetUsernameFromOutlook = "A voir ultérieurement"
End Function here
Outlook Object Model does not let you specify the parent window of the address book dialog - it will always be Outlook.
On the Extended MAPI level (C++ or Delphi), you can specify the window handle when calling IAddbook::Address, but you cannot do that from VBA.
If using Redemption (I am its author) is an option, you can set the RDOSession.ParentWindow property before using the RDOSelectNames object.
set Session = CreateObject("Redemption.RDOSession")
Session.MAPIOBJECT = Application.Session.MAPIOBJECT
Session.ParentWindow = Excel.Application.hwnd
set ABDialog = Session.GetSelectNamesDialog
ABDialog.Display true

Outlook VBA Mailitem property SenderEmailAddress not returning address correctly

So I have a program in access that lets the user select an outlook folder to import to a table. Which then can be selected from a combobox and transferred across to a form for use.
However I am having a problem with one of the values I am getting returned. SenderEmailAddress is not actually giving me an email address, for example this is what I get saved in my table.
I have removed names for privacy.
/O=COMPANY/OU=MAIL12/CN=RECIPIENTS/CN=FIRSTNAME.LASTNAME
Now of course, if I want to pass this value back over to outlook to reply to the email, I cannot use this.
Can anybody help me please?
Public Sub LoadEmails()
On Error Resume Next
'Outlook wasn't running, start it from code
If Started = False Then
Set olApp = New Outlook.Application '("Outlook.Application")
Started = True
End If
Set myNamespace = olApp.GetNamespace("MAPI")
Set objFolder = myNamespace.PickFolder
' if outlook is closed, it will display this error
If Err <> 0 Then
MsgBox "Outlook was closed. Please log out and log back in."
Started = False
Exit Sub
End If
'Exit if no folder picked.
If (objFolder Is Nothing) Then
MsgBox "No Folder Selected"
Started = False
Exit Sub
End If
Dim adoRS As Recordset
Dim intCounter As Integer
Set adoRS = CurrentDb.OpenRecordset("TBL_UserInbox") 'Open table Inbox
'Cycle through selected folder.
For intCounter = objFolder.Items.Count To 1 Step -1
With objFolder.Items(intCounter)
'Copy property value to corresponding fields
If .Class = olMail Then
adoRS.AddNew
adoRS("Subject") = .Subject
adoRS("TimeReceived") = .ReceivedTime
adoRS("Body") = .Body
adoRS("FromName") = .SenderEmailAddress '<<< Issue
adoRS("ToName") = .To
adoRS.Update
End If
End With
Next
MsgBox "Completed"
Started = False
End Sub
That is a perfectly valid email address of type EX (as opposed to SMTP). Check the MailItem.SenderEmailType property. If it is "SMTP", use the SenderEmailAddress property. If it is "EX", use MailItem.Sender.GetExchangeUser.PrimarySmtpAddress. Be prepared to handle nulls/exceptions.