Do action only with selected

[Ruegen]

Hi

I want to be able to do an action only if they are selected (and only if they meet criteria)

I have it set up at the moment to loop through all in drafts and send if they have a valid .to however I would like to select them and only send to those selected

not sure how to loop through a selection using Outlook.Explorer

[Ruegen]

so far I have



Public Sub SendDrafts()


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 myNameSpace As Outlook.NameSpace
Dim myFolders As Outlook.Folders
Dim myDraftsFolder As Outlook.MAPIFolder



Dim MsgTxt As String

Dim x As Long



MsgTxt = "Senders of selected items:"

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)

If Len(Trim(myOlSel.Item(x).To)) > 0 Then
If myOlSel.Item(x).Parent = "Drafts" Then


myOlSel.Item(x).Send
Debug.Print "Sent to: " & myOlSel.Item(x).To & " " & Time()


End If
End If

End If

Next x





End Sub


however it is only sending one and not all in selection

[Ruegen]

I've got it addressing the mailItem now but still won't send.


Public Sub SendDrafts()


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 myNameSpace As Outlook.NameSpace
Dim myFolders As Outlook.Folders
Dim myDraftsFolder As Outlook.MAPIFolder



Dim MsgTxt As String

Dim x As Long



MsgTxt = "Senders of selected items:"

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)

If Len(Trim(myOlSel.Item(x).To)) > 0 Then
If myOlSel.Item(x).Parent = "Drafts" Then


oMail.Send
Debug.Print "Sent to: " & oMail.To & " " & Time()


End If
End If

End If

Next x





End Sub

[Ruegen]

ok I have it working however it is only working if I comment out the debug.print and I don't know why!



Public Sub SendDrafts()


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 myNameSpace As Outlook.NameSpace
Dim myFolders As Outlook.Folders
Dim myDraftsFolder As Outlook.MAPIFolder



Dim MsgTxt As String

Dim x As Long



MsgTxt = "Senders of selected items:"

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)

If Len(Trim(myOlSel.Item(x).To)) > 0 Then
If myOlSel.Item(x).Parent = "Drafts" Then

Call myOlSel.Item(x).Send
' Debug.Print "Sent to: " & myOlSel.Item(x).To & " " & Time()
End If
End If

End If

Next x





End Sub

[skatonni]

ok I have it working however it is only working if I comment out the debug.print and I don't know why!




Call myOlSel.Item(x).Send
' Debug.Print "Sent to: " & myOlSel.Item(x).To & " " & Time()



Do you have an On Error Resume Next you have not shown here? You should be getting Run time error. The item has been moved or deleted.

Try this.


Debug.Print "Sent to: " & myOlSel.Item(x).To & " " & Time()
Call myOlSel.Item(x).Send