Microsoft Office Tutorials and References
In Depth Information
Sending a Message Individually to Multiple Recipients
'Error occurs if Outlook Application is not running¶
If Err Then¶
'If error then launch Outlook Application¶
Set objApp = CreateObject("Outlook.Application")¶
Err.Clear¶
End If¶
'Create Name Space object to access folder object¶
Set objNS = objApp.GetNamespace("MAPI")¶
'Create folder object to look at the Drafts folder for¶
'prepared email message¶
'olFolderDrafts = 16¶
Set objFolder = objNS.GetDefaultFolder(16)¶
'Ask user to select a mail item from Drafts folder¶
With objFolder.Items¶
For i = 1 To .Count¶
'Looking for mail items¶
'olMail = 43¶
If .Item(i).Class = 43 Then¶
strItems = strItems & vbCrLf & i & "-" & .Item(i) _¶
.subject¶
End If¶
Next i¶
End With¶
retval = InputBox("Please select email message to send " & _¶
"receipents." & vbCrLf & strItems, _¶
"Select Email Message")¶
'Validate if choice is a numeric value¶
If Not IsNumeric(retval) Then¶
GoTo ExitSub¶
'Validate if choice is a valid item number¶
ElseIf Not (retval > 0 And retval < i + 1) Then¶
GoTo ExitSub¶
End If¶
'Set mail item object by user selection¶
Set objItem = objFolder.Items.Item(CInt(retval))¶
ExitSub:¶
'Validate if Outlook Application has been set by this code¶
If Not objApp Is Nothing Then¶
'Validate if Outlook Application has a visible explorer¶
'If there is no visible explorer then¶
'it means Outlook Application has been launched from¶
'this code¶
If objApp.ActiveExplorer Is Nothing Then¶
objApp.Quit¶
End If¶
Set objApp = Nothing¶
End If¶
End Sub¶
Out
Search JabSto ::




Custom Search