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