Looking for a better trigger for incoming emails...

[adimax]

Alright, I've asked several times about this project I'm working on
and I've got some great help here. I've also done a bit of searching
and researching, and I'm stumped. I like how most of this executes,
but there is a problem with it:

The code is setup to go off on a Rule created that states when email
with XXX comes in, execute code. The problem is, it executes the code
on the currently selected email, whether that was the email that came
in and triggered the rule or not.

What I'd like is a way for the code/rule to work together and go off
on the email that comes in and ONLY that email. Whether that is or can
be done from the Inbox with the Rule detecting XXX, or if I need a
separate rule that moves the email into another folder, which then
fires off. Either way, I'm at a loss for where to start with that
code.

I hope this makes sense and anyone out there can make sense of what
I've got below.

As always, thanks very, very much in advance and for any help you can
offer.

Benjamin

---

Full Code:

Sub SaveRecording(MyMail As MailItem)

On Error Resume Next

'Declarations
Dim myItems, myItem, myAttachments, myAttachment As Object

Dim myOrt As String
Dim myFin As String

Dim myOlApp As New Outlook.Application
Dim myOlExp As Outlook.Explorer
Dim myOlSel As Outlook.Selection

Dim objFolder1 As Outlook.MAPIFolder, objFolder2 As
Outlook.MAPIFolder, objInbox As Outlook.MAPIFolder
Dim objNS As Outlook.NameSpace, objItem As Outlook.MailItem

Set objNS = Application.GetNamespace("MAPI")
Set objInbox = objNS.GetDefaultFolder(olFolderInbox)

Set objFolder1 = objInbox.Parent.Folders("[Saved]")
Set objFolder2 = objInbox.Parent.Folders("[Unsaved]")


'Destination folder for saved files
myOrt = "W:\"

'Process the selected item
Set myOlExp = myOlApp.ActiveExplorer
Set myOlSel = myOlExp.Selection

'Start Process
For Each myItem In myOlSel

'Attachments
Set myAttachments = myItem.Attachments

'Check
If myAttachments.Count > 0 Then

'Do the following
For i = 1 To myAttachments.Count

'If myAttachments(i).Item.Size < 2 Then

StartPrompt:

myFin = InputBox("Please type a filename below. You do not have to
include the .wav extension:", "Saving recording...", "")

If myFin = "" Then

myItem.UnRead = True
myItem.Move objFolder2

Exit Sub
End If

'Save to destionation folder
myAttachments(i).SaveAsFile myOrt & _
myFin & ".wav"

myItem.UnRead = False
myItem.Move objFolder1

Next i

End If

Next

'free variables
Set myItems = Nothing
Set myItem = Nothing
Set myAttachments = Nothing
Set myAttachment = Nothing
Set myOlApp = Nothing
Set myOlExp = Nothing
Set myOlSel = Nothing

End Sub

 

[Dmitry Streblechenko]

I am not sure I understand: your code is explicitly looping through all the
selected items (For Each myItem In myOlSel) instead of working on the item
passed as the argument (MyMail).

Dmitry Streblechenko (MVP)
http://www.dimastr.com/
OutlookSpy - Outlook, CDO
and MAPI Developer Tool

Alright, I've asked several times about this project I'm working on
and I've got some great help here. I've also done a bit of searching
and researching, and I'm stumped. I like how most of this executes,
but there is a problem with it:

The code is setup to go off on a Rule created that states when email
with XXX comes in, execute code. The problem is, it executes the code
on the currently selected email, whether that was the email that came
in and triggered the rule or not.

What I'd like is a way for the code/rule to work together and go off
on the email that comes in and ONLY that email. Whether that is or can
be done from the Inbox with the Rule detecting XXX, or if I need a
separate rule that moves the email into another folder, which then
fires off. Either way, I'm at a loss for where to start with that
code.

I hope this makes sense and anyone out there can make sense of what
I've got below.

As always, thanks very, very much in advance and for any help you can
offer.

Benjamin

---

Full Code:

Sub SaveRecording(MyMail As MailItem)

On Error Resume Next

'Declarations
Dim myItems, myItem, myAttachments, myAttachment As Object

Dim myOrt As String
Dim myFin As String

Dim myOlApp As New Outlook.Application
Dim myOlExp As Outlook.Explorer
Dim myOlSel As Outlook.Selection

Dim objFolder1 As Outlook.MAPIFolder, objFolder2 As
Outlook.MAPIFolder, objInbox As Outlook.MAPIFolder
Dim objNS As Outlook.NameSpace, objItem As Outlook.MailItem

Set objNS = Application.GetNamespace("MAPI")
Set objInbox = objNS.GetDefaultFolder(olFolderInbox)

Set objFolder1 = objInbox.Parent.Folders("[Saved]")
Set objFolder2 = objInbox.Parent.Folders("[Unsaved]")


'Destination folder for saved files
myOrt = "W:\"

'Process the selected item
Set myOlExp = myOlApp.ActiveExplorer
Set myOlSel = myOlExp.Selection

'Start Process
For Each myItem In myOlSel

'Attachments
Set myAttachments = myItem.Attachments

'Check
If myAttachments.Count > 0 Then

'Do the following
For i = 1 To myAttachments.Count

'If myAttachments(i).Item.Size < 2 Then

StartPrompt:

myFin = InputBox("Please type a filename below. You do not have to
include the .wav extension:", "Saving recording...", "")

If myFin = "" Then

myItem.UnRead = True
myItem.Move objFolder2

Exit Sub
End If

'Save to destionation folder
myAttachments(i).SaveAsFile myOrt & _
myFin & ".wav"

myItem.UnRead = False
myItem.Move objFolder1

Next i

End If

Next

'free variables
Set myItems = Nothing
Set myItem = Nothing
Set myAttachments = Nothing
Set myAttachment = Nothing
Set myOlApp = Nothing
Set myOlExp = Nothing
Set myOlSel = Nothing

End Sub

 

[adimax]

You are correct, Dmitry. The code was pieced together and hacked up to
suit my needs, but even then it was not what I was looking for.

I've since corrected the problem to a degree by using this:

[code start]

Private WithEvents olInboxItems As Items
Private Sub Application_Startup()
Dim objNS As NameSpace
Set objNS = Application.GetNamespace("MAPI")
Set olInboxItems = objNS.GetDefaultFolder(olFolderInbox).Items
Set objNS = Nothing
End Sub
Private Sub olInboxItems_ItemAdd(ByVal Item As Object)
Dim objAttFld1 As MAPIFolder
Dim objAttFld2 As MAPIFolder
Dim objInbox As MAPIFolder
Dim objNS As NameSpace
Dim strAttFldName1 As String
Dim strAttFldName2 As String
Dim strProgExt As String
Dim arrExt() As String
Dim objAtt As Attachment
Dim intPos As Integer
Dim I As Integer
Dim strExt As String

Dim objDes As String
Dim objFilename As String

' #### USER OPTIONS ####
' name of Inbox subfolder containing messages with attachments
strAttFldName1 = "[Saved]"
strAttFldName2 = "[Unsaved]"
' delimited list of extensions to trap
strProgExt = "wav"

'Destination folder for saved files
objDes = "W:\"

On Error Resume Next
Set objNS = Application.GetNamespace("MAPI")
Set objInbox = objNS.GetDefaultFolder(olFolderInbox)
Set objAttFld1 = objInbox.Parent.Folders(strAttFldName1)
Set objAttFld2 = objInbox.Parent.Folders(strAttFldName2)
If Item.Class = olMail Then
If objAttFld1 Is Nothing Then
' create [Saved] folder if needed
Set objAttFld1 = objInbox.Parent.Folders.Add(strAttFldName1)
End If
If objAttFld2 Is Nothing Then
' create [Unsaved] folder if needed
Set objAttFld2 = objInbox.Parent.Folders.Add(strAttFldName2)
End If
If Not objAttFld1 Is Nothing Then
' convert delimited list of extensions to array
arrExt = Split(strProgExt, ",")
For Each objAtt In Item.Attachments
intPos = InStrRev(objAtt.FileName, ".")
If intPos > 0 Then
' check attachment extension against array
strExt = LCase(Mid(objAtt.FileName, intPos + 1))
For I = LBound(arrExt) To UBound(arrExt)
If strExt = Trim(arrExt(I)) Then

StartPrompt:
objFilename = InputBox("Please type a filename (the ticket #)
below. You do not have to include the .wav extension:", "Saving
recording...", "")
If objFilename = "" Then
Item.UnRead = True
Item.Move objAttFld2
Exit Sub
End If

'Save to destionation folder
objAtt(I).SaveAsFile objDes & _
objFilename & ".wav"

Item.UnRead = False
Item.Move objAttFld1
Exit For
End If
Next
Else
' no extension; unknown type
Item.Move objAttFld
End If
Next
End If
End If

On Error GoTo 0

Set objAttFld = Nothing
Set objInbox = Nothing
Set objNS = Nothing
Set objAtt = Nothing

End Sub

[code stop]

This is modified code found from a link in this group, and its almost
at the point where I want it. It doesnt work off the currently
selected item, but does trigger off an incoming email with a .wav
attached to it. The only part I'm stuck on is getting the trigger to
be 'does it have a .wav attachement' (which works) and also 'look for
this subject' and 'from this sender'.

I'm still working on that but

If LCase$(Mail.SenderEMailAddress) = LCase$("(e-mail address removed)")
Then

doesnt seem to be working. And I've yet to find/implement a way to do
it based on a subject (that never changes in our emails).

Thanks for the reply, I'll update if I get any further.

Benjamin

 

[Dmitry Streblechenko]

The subject check will be exactly the same:
If Item.Subject = "whatever" Then ...

What is the problem with the sender address? Do you get an unexpected value
(such as an ugly EX address rather than SMTP)? Or do you get an error?
One thing I can see if that the Mail variable is never declared or
initialized. Did you mean Item?

Dmitry Streblechenko (MVP)
http://www.dimastr.com/
OutlookSpy - Outlook, CDO
and MAPI Developer Tool

You are correct, Dmitry. The code was pieced together and hacked up to
suit my needs, but even then it was not what I was looking for.

I've since corrected the problem to a degree by using this:

[code start]

Private WithEvents olInboxItems As Items
Private Sub Application_Startup()
Dim objNS As NameSpace
Set objNS = Application.GetNamespace("MAPI")
Set olInboxItems = objNS.GetDefaultFolder(olFolderInbox).Items
Set objNS = Nothing
End Sub
Private Sub olInboxItems_ItemAdd(ByVal Item As Object)
Dim objAttFld1 As MAPIFolder
Dim objAttFld2 As MAPIFolder
Dim objInbox As MAPIFolder
Dim objNS As NameSpace
Dim strAttFldName1 As String
Dim strAttFldName2 As String
Dim strProgExt As String
Dim arrExt() As String
Dim objAtt As Attachment
Dim intPos As Integer
Dim I As Integer
Dim strExt As String

Dim objDes As String
Dim objFilename As String

' #### USER OPTIONS ####
' name of Inbox subfolder containing messages with attachments
strAttFldName1 = "[Saved]"
strAttFldName2 = "[Unsaved]"
' delimited list of extensions to trap
strProgExt = "wav"

'Destination folder for saved files
objDes = "W:\"

On Error Resume Next
Set objNS = Application.GetNamespace("MAPI")
Set objInbox = objNS.GetDefaultFolder(olFolderInbox)
Set objAttFld1 = objInbox.Parent.Folders(strAttFldName1)
Set objAttFld2 = objInbox.Parent.Folders(strAttFldName2)
If Item.Class = olMail Then
If objAttFld1 Is Nothing Then
' create [Saved] folder if needed
Set objAttFld1 = objInbox.Parent.Folders.Add(strAttFldName1)
End If
If objAttFld2 Is Nothing Then
' create [Unsaved] folder if needed
Set objAttFld2 = objInbox.Parent.Folders.Add(strAttFldName2)
End If
If Not objAttFld1 Is Nothing Then
' convert delimited list of extensions to array
arrExt = Split(strProgExt, ",")
For Each objAtt In Item.Attachments
intPos = InStrRev(objAtt.FileName, ".")
If intPos > 0 Then
' check attachment extension against array
strExt = LCase(Mid(objAtt.FileName, intPos + 1))
For I = LBound(arrExt) To UBound(arrExt)
If strExt = Trim(arrExt(I)) Then

StartPrompt:
objFilename = InputBox("Please type a filename (the ticket #)
below. You do not have to include the .wav extension:", "Saving
recording...", "")
If objFilename = "" Then
Item.UnRead = True
Item.Move objAttFld2
Exit Sub
End If

'Save to destionation folder
objAtt(I).SaveAsFile objDes & _
objFilename & ".wav"

Item.UnRead = False
Item.Move objAttFld1
Exit For
End If
Next
Else
' no extension; unknown type
Item.Move objAttFld
End If
Next
End If
End If

On Error GoTo 0

Set objAttFld = Nothing
Set objInbox = Nothing
Set objNS = Nothing
Set objAtt = Nothing

End Sub

[code stop]

This is modified code found from a link in this group, and its almost
at the point where I want it. It doesnt work off the currently
selected item, but does trigger off an incoming email with a .wav
attached to it. The only part I'm stuck on is getting the trigger to
be 'does it have a .wav attachement' (which works) and also 'look for
this subject' and 'from this sender'.

I'm still working on that but

If LCase$(Mail.SenderEMailAddress) = LCase$("(e-mail address removed)")
Then

doesnt seem to be working. And I've yet to find/implement a way to do
it based on a subject (that never changes in our emails).

Thanks for the reply, I'll update if I get any further.

Benjamin

I am not sure I understand: your code is explicitly looping through all
the
selected items (For Each myItem In myOlSel) instead of working on the
item
passed as the argument (MyMail).

Dmitry Streblechenko (MVP)http://www.dimastr.com/
OutlookSpy - Outlook, CDO
and MAPI Developer Tool

 

[adimax]

Dmitry,

First, thank you for the assistance. I really, really appreciate it.

You were correct on both accounts, I believe. As far as checking the
subject goes,

' If Item.Subject = "Call Recording (Call ID:" Then

is what I am using now. However, I mistyped. The above portion of the
subject for incoming emails never changes, but after the 'ID:' there
is an always changing 6 or 7-digit number. Is there a way to wildcard
the field, or do something alone the lines of: Call Recording*.*

I'll also look into filtering it by the sender. Thanks for the info
again!

Benjamin

The subject check will be exactly the same:
If Item.Subject = "whatever" Then ...

What is the problem with the sender address? Do you get an unexpected value
(such as an ugly EX address rather than SMTP)? Or do you get an error?
One thing I can see if that the Mail variable is never declared or
initialized. Did you mean Item?

Dmitry Streblechenko (MVP)http://www.dimastr.com/
OutlookSpy - Outlook, CDO
and MAPI Developer Tool

You are correct, Dmitry. The code was pieced together and hacked up to
suit my needs, but even then it was not what I was looking for.

I've since corrected the problem to a degree by using this:

[code start]

Private WithEvents olInboxItems As Items
Private Sub Application_Startup()
Dim objNS As NameSpace
Set objNS = Application.GetNamespace("MAPI")
Set olInboxItems = objNS.GetDefaultFolder(olFolderInbox).Items
Set objNS = Nothing
End Sub
Private Sub olInboxItems_ItemAdd(ByVal Item As Object)
Dim objAttFld1 As MAPIFolder
Dim objAttFld2 As MAPIFolder
Dim objInbox As MAPIFolder
Dim objNS As NameSpace
Dim strAttFldName1 As String
Dim strAttFldName2 As String
Dim strProgExt As String
Dim arrExt() As String
Dim objAtt As Attachment
Dim intPos As Integer
Dim I As Integer
Dim strExt As String

Dim objDes As String
Dim objFilename As String

' #### USER OPTIONS ####
' name of Inbox subfolder containing messages with attachments
strAttFldName1 = "[Saved]"
strAttFldName2 = "[Unsaved]"
' delimited list of extensions to trap
strProgExt = "wav"

'Destination folder for saved files
objDes = "W:\"

On Error Resume Next
Set objNS = Application.GetNamespace("MAPI")
Set objInbox = objNS.GetDefaultFolder(olFolderInbox)
Set objAttFld1 = objInbox.Parent.Folders(strAttFldName1)
Set objAttFld2 = objInbox.Parent.Folders(strAttFldName2)
If Item.Class = olMail Then
If objAttFld1 Is Nothing Then
' create [Saved] folder if needed
Set objAttFld1 = objInbox.Parent.Folders.Add(strAttFldName1)
End If
If objAttFld2 Is Nothing Then
' create [Unsaved] folder if needed
Set objAttFld2 = objInbox.Parent.Folders.Add(strAttFldName2)
End If
If Not objAttFld1 Is Nothing Then
' convert delimited list of extensions to array
arrExt = Split(strProgExt, ",")
For Each objAtt In Item.Attachments
intPos = InStrRev(objAtt.FileName, ".")
If intPos > 0 Then
' check attachment extension against array
strExt = LCase(Mid(objAtt.FileName, intPos + 1))
For I = LBound(arrExt) To UBound(arrExt)
If strExt = Trim(arrExt(I)) Then

StartPrompt:
objFilename = InputBox("Please type a filename (the ticket #)
below. You do not have to include the .wav extension:", "Saving
recording...", "")
If objFilename = "" Then
Item.UnRead = True
Item.Move objAttFld2
Exit Sub
End If

'Save to destionation folder
objAtt(I).SaveAsFile objDes & _
objFilename & ".wav"

Item.UnRead = False
Item.Move objAttFld1
Exit For
End If
Next
Else
' no extension; unknown type
Item.Move objAttFld
End If
Next
End If
End If

On Error GoTo 0

Set objAttFld = Nothing
Set objInbox = Nothing
Set objNS = Nothing
Set objAtt = Nothing

End Sub

[code stop]

This is modified code found from a link in this group, and its almost
at the point where I want it. It doesnt work off the currently
selected item, but does trigger off an incoming email with a .wav
attached to it. The only part I'm stuck on is getting the trigger to
be 'does it have a .wav attachement' (which works) and also 'look for
this subject' and 'from this sender'.

I'm still working on that but

If LCase$(Mail.SenderEMailAddress) = LCase$("(e-mail address removed)")
Then

doesnt seem to be working. And I've yet to find/implement a way to do
it based on a subject (that never changes in our emails).

Thanks for the reply, I'll update if I get any further.

 

[Dmitry Streblechenko]

Use the Left() intrinsic VB function:

if Left(24 , Item.Subject) = "Call Recording (Call ID:" Then

Dmitry Streblechenko (MVP)
http://www.dimastr.com/
OutlookSpy - Outlook, CDO
and MAPI Developer Tool

Dmitry,

First, thank you for the assistance. I really, really appreciate it.

You were correct on both accounts, I believe. As far as checking the
subject goes,

' If Item.Subject = "Call Recording (Call ID:" Then

is what I am using now. However, I mistyped. The above portion of the
subject for incoming emails never changes, but after the 'ID:' there
is an always changing 6 or 7-digit number. Is there a way to wildcard
the field, or do something alone the lines of: Call Recording*.*

I'll also look into filtering it by the sender. Thanks for the info
again!

Benjamin

The subject check will be exactly the same:
If Item.Subject = "whatever" Then ...

What is the problem with the sender address? Do you get an unexpected
value
(such as an ugly EX address rather than SMTP)? Or do you get an error?
One thing I can see if that the Mail variable is never declared or
initialized. Did you mean Item?

Dmitry Streblechenko (MVP)http://www.dimastr.com/
OutlookSpy - Outlook, CDO
and MAPI Developer Tool

You are correct, Dmitry. The code was pieced together and hacked up to
suit my needs, but even then it was not what I was looking for.

I've since corrected the problem to a degree by using this:

[code start]

Private WithEvents olInboxItems As Items
Private Sub Application_Startup()
Dim objNS As NameSpace
Set objNS = Application.GetNamespace("MAPI")
Set olInboxItems = objNS.GetDefaultFolder(olFolderInbox).Items
Set objNS = Nothing
End Sub
Private Sub olInboxItems_ItemAdd(ByVal Item As Object)
Dim objAttFld1 As MAPIFolder
Dim objAttFld2 As MAPIFolder
Dim objInbox As MAPIFolder
Dim objNS As NameSpace
Dim strAttFldName1 As String
Dim strAttFldName2 As String
Dim strProgExt As String
Dim arrExt() As String
Dim objAtt As Attachment
Dim intPos As Integer
Dim I As Integer
Dim strExt As String

Dim objDes As String
Dim objFilename As String

' #### USER OPTIONS ####
' name of Inbox subfolder containing messages with attachments
strAttFldName1 = "[Saved]"
strAttFldName2 = "[Unsaved]"
' delimited list of extensions to trap
strProgExt = "wav"

'Destination folder for saved files
objDes = "W:\"

On Error Resume Next
Set objNS = Application.GetNamespace("MAPI")
Set objInbox = objNS.GetDefaultFolder(olFolderInbox)
Set objAttFld1 = objInbox.Parent.Folders(strAttFldName1)
Set objAttFld2 = objInbox.Parent.Folders(strAttFldName2)
If Item.Class = olMail Then
If objAttFld1 Is Nothing Then
' create [Saved] folder if needed
Set objAttFld1 = objInbox.Parent.Folders.Add(strAttFldName1)
End If
If objAttFld2 Is Nothing Then
' create [Unsaved] folder if needed
Set objAttFld2 = objInbox.Parent.Folders.Add(strAttFldName2)
End If
If Not objAttFld1 Is Nothing Then
' convert delimited list of extensions to array
arrExt = Split(strProgExt, ",")
For Each objAtt In Item.Attachments
intPos = InStrRev(objAtt.FileName, ".")
If intPos > 0 Then
' check attachment extension against array
strExt = LCase(Mid(objAtt.FileName, intPos + 1))
For I = LBound(arrExt) To UBound(arrExt)
If strExt = Trim(arrExt(I)) Then

StartPrompt:
objFilename = InputBox("Please type a filename (the ticket #)
below. You do not have to include the .wav extension:", "Saving
recording...", "")
If objFilename = "" Then
Item.UnRead = True
Item.Move objAttFld2
Exit Sub
End If

'Save to destionation folder
objAtt(I).SaveAsFile objDes & _
objFilename & ".wav"

Item.UnRead = False
Item.Move objAttFld1
Exit For
End If
Next
Else
' no extension; unknown type
Item.Move objAttFld
End If
Next
End If
End If

On Error GoTo 0

Set objAttFld = Nothing
Set objInbox = Nothing
Set objNS = Nothing
Set objAtt = Nothing

End Sub

[code stop]

This is modified code found from a link in this group, and its almost
at the point where I want it. It doesnt work off the currently
selected item, but does trigger off an incoming email with a .wav
attached to it. The only part I'm stuck on is getting the trigger to
be 'does it have a .wav attachement' (which works) and also 'look for
this subject' and 'from this sender'.

I'm still working on that but

If LCase$(Mail.SenderEMailAddress) = LCase$("(e-mail address removed)")
Then

doesnt seem to be working. And I've yet to find/implement a way to do
it based on a subject (that never changes in our emails).

Thanks for the reply, I'll update if I get any further.

I am not sure I understand: your code is explicitly looping through
all
the
selected items (For Each myItem In myOlSel) instead of working on the
item
passed as the argument (MyMail).

Dmitry Streblechenko (MVP)http://www.dimastr.com/
OutlookSpy - Outlook, CDO
and MAPI Developer Tool

 

[adimax]

Dmitry,

I really thought we had it, but it's still not working. There are no
errors generated, but when I send myself a test email with a different
subject line, it still processes as if it met the specified subject
line/executes to the Input Box. I'm looking for it to stop processing
if the subject line doesnt match.

The exact opposite happens if I specify a sender email address. It
does not process to the Input Box and appears to be stopped cold. I've
even tried specifying my email address and sending myself an email
with a .wav attached, nothing.

Here's the full code again, tweaked a bit since last time:

[start code]

Private WithEvents olInboxItems As Items
Private Sub Application_Startup()
Dim objNS As NameSpace
Set objNS = Application.GetNamespace("MAPI")
Set olInboxItems = objNS.GetDefaultFolder(olFolderInbox).Items
Set objNS = Nothing
End Sub
Private Sub olInboxItems_ItemAdd(ByVal Item As Object)
Dim objAttFld1 As MAPIFolder
Dim objAttFld2 As MAPIFolder
Dim objInbox As MAPIFolder
Dim objNS As NameSpace
Dim strAttFldName1 As String
Dim strAttFldName2 As String
Dim strProgExt As String
Dim arrExt() As String
Dim objAtt As Attachment
Dim intPos As Integer
Dim I As Integer
Dim strExt As String

Dim objDes As String
Dim objFilename As String

' #### USER OPTIONS ####
' name of Inbox subfolder containing messages with attachments
strAttFldName1 = "[Saved]"
strAttFldName2 = "[Unsaved]"
' delimited list of extensions to trap
strProgExt = "wav"

'Destination folder for saved files
objDes = "W:\"

On Error Resume Next

Set objNS = Application.GetNamespace("MAPI")
Set objInbox = objNS.GetDefaultFolder(olFolderInbox)
Set objAttFld1 = objInbox.Parent.Folders(strAttFldName1)
Set objAttFld2 = objInbox.Parent.Folders(strAttFldName2)

If Item.Class = olMail Then

'Check Sender
'If Item.SenderEmailAddress = "(e-mail address removed)" Then

'Check Subject
If Left(39, Item.Subject) = "IC Voicemail: Call Recording (Call ID:
" Then

If objAttFld1 Is Nothing Then
' create [Saved] folder if needed
Set objAttFld1 = objInbox.Parent.Folders.Add(strAttFldName1)
End If
If objAttFld2 Is Nothing Then
' create [Unsaved] folder if needed
Set objAttFld2 = objInbox.Parent.Folders.Add(strAttFldName2)
End If

If Not objAttFld1 Is Nothing Then
' convert delimited list of extensions to array
arrExt = Split(strProgExt, ",")
For Each objAtt In Item.Attachments
intPos = InStrRev(objAtt.FileName, ".")
If intPos > 0 Then
' check attachment extension against array
strExt = LCase(Mid(objAtt.FileName, intPos + 1))
For I = LBound(arrExt) To UBound(arrExt)
If strExt = Trim(arrExt(I)) Then

StartPrompt:
objFilename = InputBox("Please type a filename (the ticket #)
below. You do not have to include the .wav extension:", "Saving
recording...", "")
If objFilename = "" Then
Item.UnRead = True
Item.Move objAttFld2
Exit Sub
End If

'Save to destination folder
objAtt.SaveAsFile objDes & _
objFilename & ".wav"

Item.UnRead = False
Item.Move objAttFld1
Exit For
End If
Next
Else
' no extension; unknown type
' Item.Move objAttFld
End If
Next
End If
End If
End If
'End If

On Error GoTo 0

Set objAttFld = Nothing
Set objInbox = Nothing
Set objNS = Nothing
Set objAtt = Nothing

End Sub

[end code]

I've also tried a

If Left (2, Item.Subject) = "IC" Then

and a

If Left(4, Item.Subject) = "test" Then

and they both do the same as the actual code.

Is it out of order somehow or can you think of any other reason this
is not running through the steps normally?

Benjamin

Use the Left() intrinsic VB function:

if Left(24 , Item.Subject) = "Call Recording (Call ID:" Then

Dmitry Streblechenko (MVP)http://www.dimastr.com/
OutlookSpy - Outlook, CDO
and MAPI Developer Tool

Dmitry,

First, thank you for the assistance. I really, really appreciate it.

You were correct on both accounts, I believe. As far as checking the
subject goes,

' If Item.Subject = "Call Recording (Call ID:" Then

is what I am using now. However, I mistyped. The above portion of the
subject for incoming emails never changes, but after the 'ID:' there
is an always changing 6 or 7-digit number. Is there a way to wildcard
the field, or do something alone the lines of: Call Recording*.*

I'll also look into filtering it by the sender. Thanks for the info
again!

Benjamin

The subject check will be exactly the same:
If Item.Subject = "whatever" Then ...
What is the problem with the sender address? Do you get an unexpected
value
(such as an ugly EX address rather than SMTP)? Or do you get an error?
One thing I can see if that the Mail variable is never declared or
initialized. Did you mean Item?
Dmitry Streblechenko (MVP)http://www.dimastr.com/
OutlookSpy - Outlook, CDO
and MAPI Developer Tool

You are correct, Dmitry. The code was pieced together and hacked up to
suit my needs, but even then it was not what I was looking for.
I've since corrected the problem to a degree by using this:
[code start]
Private WithEvents olInboxItems As Items
Private Sub Application_Startup()
Dim objNS As NameSpace
Set objNS = Application.GetNamespace("MAPI")
Set olInboxItems = objNS.GetDefaultFolder(olFolderInbox).Items
Set objNS = Nothing
End Sub
Private Sub olInboxItems_ItemAdd(ByVal Item As Object)
Dim objAttFld1 As MAPIFolder
Dim objAttFld2 As MAPIFolder
Dim objInbox As MAPIFolder
Dim objNS As NameSpace
Dim strAttFldName1 As String
Dim strAttFldName2 As String
Dim strProgExt As String
Dim arrExt() As String
Dim objAtt As Attachment
Dim intPos As Integer
Dim I As Integer
Dim strExt As String
Dim objDes As String
Dim objFilename As String
' #### USER OPTIONS ####
' name of Inbox subfolder containing messages with attachments
strAttFldName1 = "[Saved]"
strAttFldName2 = "[Unsaved]"
' delimited list of extensions to trap
strProgExt = "wav"
'Destination folder for saved files
objDes = "W:\"
On Error Resume Next
Set objNS = Application.GetNamespace("MAPI")
Set objInbox = objNS.GetDefaultFolder(olFolderInbox)
Set objAttFld1 = objInbox.Parent.Folders(strAttFldName1)
Set objAttFld2 = objInbox.Parent.Folders(strAttFldName2)
If Item.Class = olMail Then
If objAttFld1 Is Nothing Then
' create [Saved] folder if needed
Set objAttFld1 = objInbox.Parent.Folders.Add(strAttFldName1)
End If
If objAttFld2 Is Nothing Then
' create [Unsaved] folder if needed
Set objAttFld2 = objInbox.Parent.Folders.Add(strAttFldName2)
End If
If Not objAttFld1 Is Nothing Then
' convert delimited list of extensions to array
arrExt = Split(strProgExt, ",")
For Each objAtt In Item.Attachments
intPos = InStrRev(objAtt.FileName, ".")
If intPos > 0 Then
' check attachment extension against array
strExt = LCase(Mid(objAtt.FileName, intPos + 1))
For I = LBound(arrExt) To UBound(arrExt)
If strExt = Trim(arrExt(I)) Then
StartPrompt:
objFilename = InputBox("Please type a filename (the ticket #)
below. You do not have to include the .wav extension:", "Saving
recording...", "")
If objFilename = "" Then
Item.UnRead = True
Item.Move objAttFld2
Exit Sub
End If
'Save to destionation folder
objAtt(I).SaveAsFile objDes & _
objFilename & ".wav"
Item.UnRead = False
Item.Move objAttFld1
Exit For
End If
Next
Else
' no extension; unknown type
Item.Move objAttFld
End If
Next
End If
End If
On Error GoTo 0
Set objAttFld = Nothing
Set objInbox = Nothing
Set objNS = Nothing
Set objAtt = Nothing
End Sub
[code stop]
This is modified code found from a link in this group, and its almost
at the point where I want it. It doesnt work off the currently
selected item, but does trigger off an incoming email with a .wav
attached to it. The only part I'm stuck on is getting the trigger to
be 'does it have a .wav attachement' (which works) and also 'look for
this subject' and 'from this sender'.
I'm still working on that but
If LCase$(Mail.SenderEMailAddress) = LCase$("(e-mail address removed)")
Then
doesnt seem to be working. And I've yet to find/implement a way to do
it based on a subject (that never changes in our emails).
Thanks for the reply, I'll update if I get any further.
Benjamin
I am not sure I understand: your code is explicitly looping through
all
the
selected items (For Each myItem In myOlSel) instead of working on the
item
passed as the argument (MyMail).
Dmitry Streblechenko (MVP)http://www.dimastr.com/
OutlookSpy - Outlook, CDO
and MAPI Developer Tool

 

[Dmitry Streblechenko]

Without actually running the script, looks perfectly fine to me.
Can you try to add something like

MsgBox Item.Subject

to make sure the subject is really wrong?

Dmitry Streblechenko (MVP)
http://www.dimastr.com/
OutlookSpy - Outlook, CDO
and MAPI Developer Tool

Dmitry,

I really thought we had it, but it's still not working. There are no
errors generated, but when I send myself a test email with a different
subject line, it still processes as if it met the specified subject
line/executes to the Input Box. I'm looking for it to stop processing
if the subject line doesnt match.

The exact opposite happens if I specify a sender email address. It
does not process to the Input Box and appears to be stopped cold. I've
even tried specifying my email address and sending myself an email
with a .wav attached, nothing.

Here's the full code again, tweaked a bit since last time:

[start code]

Private WithEvents olInboxItems As Items
Private Sub Application_Startup()
Dim objNS As NameSpace
Set objNS = Application.GetNamespace("MAPI")
Set olInboxItems = objNS.GetDefaultFolder(olFolderInbox).Items
Set objNS = Nothing
End Sub
Private Sub olInboxItems_ItemAdd(ByVal Item As Object)
Dim objAttFld1 As MAPIFolder
Dim objAttFld2 As MAPIFolder
Dim objInbox As MAPIFolder
Dim objNS As NameSpace
Dim strAttFldName1 As String
Dim strAttFldName2 As String
Dim strProgExt As String
Dim arrExt() As String
Dim objAtt As Attachment
Dim intPos As Integer
Dim I As Integer
Dim strExt As String

Dim objDes As String
Dim objFilename As String

' #### USER OPTIONS ####
' name of Inbox subfolder containing messages with attachments
strAttFldName1 = "[Saved]"
strAttFldName2 = "[Unsaved]"
' delimited list of extensions to trap
strProgExt = "wav"

'Destination folder for saved files
objDes = "W:\"

On Error Resume Next

Set objNS = Application.GetNamespace("MAPI")
Set objInbox = objNS.GetDefaultFolder(olFolderInbox)
Set objAttFld1 = objInbox.Parent.Folders(strAttFldName1)
Set objAttFld2 = objInbox.Parent.Folders(strAttFldName2)

If Item.Class = olMail Then

'Check Sender
'If Item.SenderEmailAddress = "(e-mail address removed)" Then

'Check Subject
If Left(39, Item.Subject) = "IC Voicemail: Call Recording (Call ID:
" Then

If objAttFld1 Is Nothing Then
' create [Saved] folder if needed
Set objAttFld1 = objInbox.Parent.Folders.Add(strAttFldName1)
End If
If objAttFld2 Is Nothing Then
' create [Unsaved] folder if needed
Set objAttFld2 = objInbox.Parent.Folders.Add(strAttFldName2)
End If

If Not objAttFld1 Is Nothing Then
' convert delimited list of extensions to array
arrExt = Split(strProgExt, ",")
For Each objAtt In Item.Attachments
intPos = InStrRev(objAtt.FileName, ".")
If intPos > 0 Then
' check attachment extension against array
strExt = LCase(Mid(objAtt.FileName, intPos + 1))
For I = LBound(arrExt) To UBound(arrExt)
If strExt = Trim(arrExt(I)) Then

StartPrompt:
objFilename = InputBox("Please type a filename (the ticket #)
below. You do not have to include the .wav extension:", "Saving
recording...", "")
If objFilename = "" Then
Item.UnRead = True
Item.Move objAttFld2
Exit Sub
End If

'Save to destination folder
objAtt.SaveAsFile objDes & _
objFilename & ".wav"

Item.UnRead = False
Item.Move objAttFld1
Exit For
End If
Next
Else
' no extension; unknown type
' Item.Move objAttFld
End If
Next
End If
End If
End If
'End If

On Error GoTo 0

Set objAttFld = Nothing
Set objInbox = Nothing
Set objNS = Nothing
Set objAtt = Nothing

End Sub

[end code]

I've also tried a

If Left (2, Item.Subject) = "IC" Then

and a

If Left(4, Item.Subject) = "test" Then

and they both do the same as the actual code.

Is it out of order somehow or can you think of any other reason this
is not running through the steps normally?

Benjamin

Use the Left() intrinsic VB function:

if Left(24 , Item.Subject) = "Call Recording (Call ID:" Then

Dmitry Streblechenko (MVP)http://www.dimastr.com/
OutlookSpy - Outlook, CDO
and MAPI Developer Tool

Dmitry,

First, thank you for the assistance. I really, really appreciate it.

You were correct on both accounts, I believe. As far as checking the
subject goes,

' If Item.Subject = "Call Recording (Call ID:" Then

is what I am using now. However, I mistyped. The above portion of the
subject for incoming emails never changes, but after the 'ID:' there
is an always changing 6 or 7-digit number. Is there a way to wildcard
the field, or do something alone the lines of: Call Recording*.*

I'll also look into filtering it by the sender. Thanks for the info
again!

The subject check will be exactly the same:
If Item.Subject = "whatever" Then ...

What is the problem with the sender address? Do you get an unexpected
value
(such as an ugly EX address rather than SMTP)? Or do you get an error?
One thing I can see if that the Mail variable is never declared or
initialized. Did you mean Item?

Dmitry Streblechenko (MVP)http://www.dimastr.com/
OutlookSpy - Outlook, CDO
and MAPI Developer Tool

You are correct, Dmitry. The code was pieced together and hacked up
to
suit my needs, but even then it was not what I was looking for.

I've since corrected the problem to a degree by using this:

[code start]

Private WithEvents olInboxItems As Items
Private Sub Application_Startup()
Dim objNS As NameSpace
Set objNS = Application.GetNamespace("MAPI")
Set olInboxItems = objNS.GetDefaultFolder(olFolderInbox).Items
Set objNS = Nothing
End Sub
Private Sub olInboxItems_ItemAdd(ByVal Item As Object)
Dim objAttFld1 As MAPIFolder
Dim objAttFld2 As MAPIFolder
Dim objInbox As MAPIFolder
Dim objNS As NameSpace
Dim strAttFldName1 As String
Dim strAttFldName2 As String
Dim strProgExt As String
Dim arrExt() As String
Dim objAtt As Attachment
Dim intPos As Integer
Dim I As Integer
Dim strExt As String

Dim objDes As String
Dim objFilename As String

' #### USER OPTIONS ####
' name of Inbox subfolder containing messages with attachments
strAttFldName1 = "[Saved]"
strAttFldName2 = "[Unsaved]"
' delimited list of extensions to trap
strProgExt = "wav"

'Destination folder for saved files
objDes = "W:\"

On Error Resume Next
Set objNS = Application.GetNamespace("MAPI")
Set objInbox = objNS.GetDefaultFolder(olFolderInbox)
Set objAttFld1 = objInbox.Parent.Folders(strAttFldName1)
Set objAttFld2 = objInbox.Parent.Folders(strAttFldName2)
If Item.Class = olMail Then
If objAttFld1 Is Nothing Then
' create [Saved] folder if needed
Set objAttFld1 = objInbox.Parent.Folders.Add(strAttFldName1)
End If
If objAttFld2 Is Nothing Then
' create [Unsaved] folder if needed
Set objAttFld2 = objInbox.Parent.Folders.Add(strAttFldName2)
End If
If Not objAttFld1 Is Nothing Then
' convert delimited list of extensions to array
arrExt = Split(strProgExt, ",")
For Each objAtt In Item.Attachments
intPos = InStrRev(objAtt.FileName, ".")
If intPos > 0 Then
' check attachment extension against array
strExt = LCase(Mid(objAtt.FileName, intPos + 1))
For I = LBound(arrExt) To UBound(arrExt)
If strExt = Trim(arrExt(I)) Then

StartPrompt:
objFilename = InputBox("Please type a filename (the ticket #)
below. You do not have to include the .wav extension:", "Saving
recording...", "")
If objFilename = "" Then
Item.UnRead = True
Item.Move objAttFld2
Exit Sub
End If

'Save to destionation folder
objAtt(I).SaveAsFile objDes & _
objFilename & ".wav"

Item.UnRead = False
Item.Move objAttFld1
Exit For
End If
Next
Else
' no extension; unknown type
Item.Move objAttFld
End If
Next
End If
End If

On Error GoTo 0

Set objAttFld = Nothing
Set objInbox = Nothing
Set objNS = Nothing
Set objAtt = Nothing

End Sub

[code stop]

This is modified code found from a link in this group, and its
almost
at the point where I want it. It doesnt work off the currently
selected item, but does trigger off an incoming email with a .wav
attached to it. The only part I'm stuck on is getting the trigger to
be 'does it have a .wav attachement' (which works) and also 'look
for
this subject' and 'from this sender'.

I'm still working on that but

If LCase$(Mail.SenderEMailAddress) =
LCase$("(e-mail address removed)")
Then

doesnt seem to be working. And I've yet to find/implement a way to
do
it based on a subject (that never changes in our emails).

Thanks for the reply, I'll update if I get any further.

On Aug 29, 4:47 pm, "Dmitry Streblechenko" <[email protected]>
wrote:
I am not sure I understand: your code is explicitly looping through
all
the
selected items (For Each myItem In myOlSel) instead of working on
the
item
passed as the argument (MyMail).

Dmitry Streblechenko (MVP)http://www.dimastr.com/
OutlookSpy - Outlook, CDO
and MAPI Developer Tool

 

[adimax]

It does exactly what you'd expect: pops the box up with the Subject
text (in my case 'WHY WONT YOU WORK! ARGH!', hehehe) and if I click
Ok, it goes right on through to the 2nd pop-up box asking for the file
name.

Its so frustrating because the If statement later on does work in the
sense of if I click cancel or leave the filename blank, it moves the
file to the appropriate folder/doesn't save the attachment (based on
it = "", or [blank]). I thought Ifs had an implicit else = end sub. Is
this not the case?

Any other ideas or ways to have it fire ONLY on a specific subject?
Some way to reverse the way it looks at it? If I can get this issue
resolved, the code will definitely be rolled out to the rest of the
floor.

Benjamin

Without actually running the script, looks perfectly fine to me.
Can you try to add something like

MsgBox Item.Subject

to make sure the subject is really wrong?

Dmitry Streblechenko (MVP)http://www.dimastr.com/
OutlookSpy - Outlook, CDO
and MAPI Developer Tool

Dmitry,

I really thought we had it, but it's still not working. There are no
errors generated, but when I send myself a test email with a different
subject line, it still processes as if it met the specified subject
line/executes to the Input Box. I'm looking for it to stop processing
if the subject line doesnt match.

The exact opposite happens if I specify a sender email address. It
does not process to the Input Box and appears to be stopped cold. I've
even tried specifying my email address and sending myself an email
with a .wav attached, nothing.

Here's the full code again, tweaked a bit since last time:

[start code]

Private WithEvents olInboxItems As Items
Private Sub Application_Startup()
Dim objNS As NameSpace
Set objNS = Application.GetNamespace("MAPI")
Set olInboxItems = objNS.GetDefaultFolder(olFolderInbox).Items
Set objNS = Nothing
End Sub
Private Sub olInboxItems_ItemAdd(ByVal Item As Object)
Dim objAttFld1 As MAPIFolder
Dim objAttFld2 As MAPIFolder
Dim objInbox As MAPIFolder
Dim objNS As NameSpace
Dim strAttFldName1 As String
Dim strAttFldName2 As String
Dim strProgExt As String
Dim arrExt() As String
Dim objAtt As Attachment
Dim intPos As Integer
Dim I As Integer
Dim strExt As String

Dim objDes As String
Dim objFilename As String

' #### USER OPTIONS ####
' name of Inbox subfolder containing messages with attachments
strAttFldName1 = "[Saved]"
strAttFldName2 = "[Unsaved]"
' delimited list of extensions to trap
strProgExt = "wav"

'Destination folder for saved files
objDes = "W:\"

On Error Resume Next

Set objNS = Application.GetNamespace("MAPI")
Set objInbox = objNS.GetDefaultFolder(olFolderInbox)
Set objAttFld1 = objInbox.Parent.Folders(strAttFldName1)
Set objAttFld2 = objInbox.Parent.Folders(strAttFldName2)

If Item.Class = olMail Then

'Check Sender
'If Item.SenderEmailAddress = "(e-mail address removed)" Then

'Check Subject
If Left(39, Item.Subject) = "IC Voicemail: Call Recording (Call ID:
" Then

If objAttFld1 Is Nothing Then
' create [Saved] folder if needed
Set objAttFld1 = objInbox.Parent.Folders.Add(strAttFldName1)
End If
If objAttFld2 Is Nothing Then
' create [Unsaved] folder if needed
Set objAttFld2 = objInbox.Parent.Folders.Add(strAttFldName2)
End If

If Not objAttFld1 Is Nothing Then
' convert delimited list of extensions to array
arrExt = Split(strProgExt, ",")
For Each objAtt In Item.Attachments
intPos = InStrRev(objAtt.FileName, ".")
If intPos > 0 Then
' check attachment extension against array
strExt = LCase(Mid(objAtt.FileName, intPos + 1))
For I = LBound(arrExt) To UBound(arrExt)
If strExt = Trim(arrExt(I)) Then

StartPrompt:
objFilename = InputBox("Please type a filename (the ticket #)
below. You do not have to include the .wav extension:", "Saving
recording...", "")
If objFilename = "" Then
Item.UnRead = True
Item.Move objAttFld2
Exit Sub
End If

'Save to destination folder
objAtt.SaveAsFile objDes & _
objFilename & ".wav"

Item.UnRead = False
Item.Move objAttFld1
Exit For
End If
Next
Else
' no extension; unknown type
' Item.Move objAttFld
End If
Next
End If
End If
End If
'End If

On Error GoTo 0

Set objAttFld = Nothing
Set objInbox = Nothing
Set objNS = Nothing
Set objAtt = Nothing

End Sub

[end code]

I've also tried a

If Left (2, Item.Subject) = "IC" Then

and a

If Left(4, Item.Subject) = "test" Then

and they both do the same as the actual code.

Is it out of order somehow or can you think of any other reason this
is not running through the steps normally?

Benjamin

Use the Left() intrinsic VB function:
if Left(24 , Item.Subject) = "Call Recording (Call ID:" Then
Dmitry Streblechenko (MVP)http://www.dimastr.com/
OutlookSpy - Outlook, CDO
and MAPI Developer Tool

Dmitry,
First, thank you for the assistance. I really, really appreciate it.
You were correct on both accounts, I believe. As far as checking the
subject goes,
' If Item.Subject = "Call Recording (Call ID:" Then
is what I am using now. However, I mistyped. The above portion of the
subject for incoming emails never changes, but after the 'ID:' there
is an always changing 6 or 7-digit number. Is there a way to wildcard
the field, or do something alone the lines of: Call Recording*.*
I'll also look into filtering it by the sender. Thanks for the info
again!
Benjamin
The subject check will be exactly the same:
If Item.Subject = "whatever" Then ...
What is the problem with the sender address? Do you get an unexpected
value
(such as an ugly EX address rather than SMTP)? Or do you get an error?
One thing I can see if that the Mail variable is never declared or
initialized. Did you mean Item?
Dmitry Streblechenko (MVP)http://www.dimastr.com/
OutlookSpy - Outlook, CDO
and MAPI Developer Tool

You are correct, Dmitry. The code was pieced together and hacked up
to
suit my needs, but even then it was not what I was looking for.
I've since corrected the problem to a degree by using this:
[code start]
Private WithEvents olInboxItems As Items
Private Sub Application_Startup()
Dim objNS As NameSpace
Set objNS = Application.GetNamespace("MAPI")
Set olInboxItems = objNS.GetDefaultFolder(olFolderInbox).Items
Set objNS = Nothing
End Sub
Private Sub olInboxItems_ItemAdd(ByVal Item As Object)
Dim objAttFld1 As MAPIFolder
Dim objAttFld2 As MAPIFolder
Dim objInbox As MAPIFolder
Dim objNS As NameSpace
Dim strAttFldName1 As String
Dim strAttFldName2 As String
Dim strProgExt As String
Dim arrExt() As String
Dim objAtt As Attachment
Dim intPos As Integer
Dim I As Integer
Dim strExt As String
Dim objDes As String
Dim objFilename As String
' #### USER OPTIONS ####
' name of Inbox subfolder containing messages with attachments
strAttFldName1 = "[Saved]"
strAttFldName2 = "[Unsaved]"
' delimited list of extensions to trap
strProgExt = "wav"
'Destination folder for saved files
objDes = "W:\"
On Error Resume Next
Set objNS = Application.GetNamespace("MAPI")
Set objInbox = objNS.GetDefaultFolder(olFolderInbox)
Set objAttFld1 = objInbox.Parent.Folders(strAttFldName1)
Set objAttFld2 = objInbox.Parent.Folders(strAttFldName2)
If Item.Class = olMail Then
If objAttFld1 Is Nothing Then
' create [Saved] folder if needed
Set objAttFld1 = objInbox.Parent.Folders.Add(strAttFldName1)
End If
If objAttFld2 Is Nothing Then
' create [Unsaved] folder if needed
Set objAttFld2 = objInbox.Parent.Folders.Add(strAttFldName2)
End If
If Not objAttFld1 Is Nothing Then
' convert delimited list of extensions to array
arrExt = Split(strProgExt, ",")
For Each objAtt In Item.Attachments
intPos = InStrRev(objAtt.FileName, ".")
If intPos > 0 Then
' check attachment extension against array
strExt = LCase(Mid(objAtt.FileName, intPos + 1))
For I = LBound(arrExt) To UBound(arrExt)
If strExt = Trim(arrExt(I)) Then
StartPrompt:
objFilename = InputBox("Please type a filename (the ticket #)
below. You do not have to include the .wav extension:", "Saving
recording...", "")
If objFilename = "" Then
Item.UnRead = True
Item.Move objAttFld2
Exit Sub
End If
'Save to destionation folder
objAtt(I).SaveAsFile objDes & _
objFilename & ".wav"
Item.UnRead = False
Item.Move objAttFld1
Exit For
End If
Next
Else
' no extension; unknown type
Item.Move objAttFld
End If
Next
End If
End If
On Error GoTo 0
Set objAttFld = Nothing
Set objInbox = Nothing
Set objNS = Nothing
Set objAtt = Nothing
End Sub
[code stop]
This is modified code found from a link in this group, and its
almost
at the point where I want it. It doesnt work off the currently
selected item, but does trigger off an

...

read more »

 

[Dmitry Streblechenko]

Arghh... Sorry, replace
Left(39, Item.Subject)
with
Left(Item.Subject, 39)
I am suprised VBA idd not raise an error since I had the arguments of wrong
types in the wrong order

Dmitry Streblechenko (MVP)
http://www.dimastr.com/
OutlookSpy - Outlook, CDO
and MAPI Developer Tool

It does exactly what you'd expect: pops the box up with the Subject
text (in my case 'WHY WONT YOU WORK! ARGH!', hehehe) and if I click
Ok, it goes right on through to the 2nd pop-up box asking for the file
name.

Its so frustrating because the If statement later on does work in the
sense of if I click cancel or leave the filename blank, it moves the
file to the appropriate folder/doesn't save the attachment (based on
it = "", or [blank]). I thought Ifs had an implicit else = end sub. Is
this not the case?

Any other ideas or ways to have it fire ONLY on a specific subject?
Some way to reverse the way it looks at it? If I can get this issue
resolved, the code will definitely be rolled out to the rest of the
floor.

Benjamin

Without actually running the script, looks perfectly fine to me.
Can you try to add something like

MsgBox Item.Subject

to make sure the subject is really wrong?

Dmitry Streblechenko (MVP)http://www.dimastr.com/
OutlookSpy - Outlook, CDO
and MAPI Developer Tool

Dmitry,

I really thought we had it, but it's still not working. There are no
errors generated, but when I send myself a test email with a different
subject line, it still processes as if it met the specified subject
line/executes to the Input Box. I'm looking for it to stop processing
if the subject line doesnt match.

The exact opposite happens if I specify a sender email address. It
does not process to the Input Box and appears to be stopped cold. I've
even tried specifying my email address and sending myself an email
with a .wav attached, nothing.

Here's the full code again, tweaked a bit since last time:

[start code]

Private WithEvents olInboxItems As Items
Private Sub Application_Startup()
Dim objNS As NameSpace
Set objNS = Application.GetNamespace("MAPI")
Set olInboxItems = objNS.GetDefaultFolder(olFolderInbox).Items
Set objNS = Nothing
End Sub
Private Sub olInboxItems_ItemAdd(ByVal Item As Object)
Dim objAttFld1 As MAPIFolder
Dim objAttFld2 As MAPIFolder
Dim objInbox As MAPIFolder
Dim objNS As NameSpace
Dim strAttFldName1 As String
Dim strAttFldName2 As String
Dim strProgExt As String
Dim arrExt() As String
Dim objAtt As Attachment
Dim intPos As Integer
Dim I As Integer
Dim strExt As String

Dim objDes As String
Dim objFilename As String

' #### USER OPTIONS ####
' name of Inbox subfolder containing messages with attachments
strAttFldName1 = "[Saved]"
strAttFldName2 = "[Unsaved]"
' delimited list of extensions to trap
strProgExt = "wav"

'Destination folder for saved files
objDes = "W:\"

On Error Resume Next

Set objNS = Application.GetNamespace("MAPI")
Set objInbox = objNS.GetDefaultFolder(olFolderInbox)
Set objAttFld1 = objInbox.Parent.Folders(strAttFldName1)
Set objAttFld2 = objInbox.Parent.Folders(strAttFldName2)

If Item.Class = olMail Then

'Check Sender
'If Item.SenderEmailAddress = "(e-mail address removed)" Then

'Check Subject
If Left(39, Item.Subject) = "IC Voicemail: Call Recording (Call ID:
" Then

If objAttFld1 Is Nothing Then
' create [Saved] folder if needed
Set objAttFld1 = objInbox.Parent.Folders.Add(strAttFldName1)
End If
If objAttFld2 Is Nothing Then
' create [Unsaved] folder if needed
Set objAttFld2 = objInbox.Parent.Folders.Add(strAttFldName2)
End If

If Not objAttFld1 Is Nothing Then
' convert delimited list of extensions to array
arrExt = Split(strProgExt, ",")
For Each objAtt In Item.Attachments
intPos = InStrRev(objAtt.FileName, ".")
If intPos > 0 Then
' check attachment extension against array
strExt = LCase(Mid(objAtt.FileName, intPos + 1))
For I = LBound(arrExt) To UBound(arrExt)
If strExt = Trim(arrExt(I)) Then

StartPrompt:
objFilename = InputBox("Please type a filename (the ticket #)
below. You do not have to include the .wav extension:", "Saving
recording...", "")
If objFilename = "" Then
Item.UnRead = True
Item.Move objAttFld2
Exit Sub
End If

'Save to destination folder
objAtt.SaveAsFile objDes & _
objFilename & ".wav"

Item.UnRead = False
Item.Move objAttFld1
Exit For
End If
Next
Else
' no extension; unknown type
' Item.Move objAttFld
End If
Next
End If
End If
End If
'End If

On Error GoTo 0

Set objAttFld = Nothing
Set objInbox = Nothing
Set objNS = Nothing
Set objAtt = Nothing

End Sub

[end code]

I've also tried a

If Left (2, Item.Subject) = "IC" Then

and a

If Left(4, Item.Subject) = "test" Then

and they both do the same as the actual code.

Is it out of order somehow or can you think of any other reason this
is not running through the steps normally?

Benjamin

Use the Left() intrinsic VB function:
if Left(24 , Item.Subject) = "Call Recording (Call ID:" Then
Dmitry Streblechenko (MVP)http://www.dimastr.com/
OutlookSpy - Outlook, CDO
and MAPI Developer Tool

Dmitry,
First, thank you for the assistance. I really, really appreciate it.
You were correct on both accounts, I believe. As far as checking the
subject goes,
' If Item.Subject = "Call Recording (Call ID:" Then
is what I am using now. However, I mistyped. The above portion of the
subject for incoming emails never changes, but after the 'ID:' there
is an always changing 6 or 7-digit number. Is there a way to wildcard
the field, or do something alone the lines of: Call Recording*.*
I'll also look into filtering it by the sender. Thanks for the info
again!
Benjamin
On Aug 29, 7:58 pm, "Dmitry Streblechenko" <[email protected]>
wrote:
The subject check will be exactly the same:
If Item.Subject = "whatever" Then ...
What is the problem with the sender address? Do you get an
unexpected
value
(such as an ugly EX address rather than SMTP)? Or do you get an
error?
One thing I can see if that the Mail variable is never declared or
initialized. Did you mean Item?
Dmitry Streblechenko (MVP)http://www.dimastr.com/
OutlookSpy - Outlook, CDO
and MAPI Developer Tool

You are correct, Dmitry. The code was pieced together and hacked
up
to
suit my needs, but even then it was not what I was looking for.
I've since corrected the problem to a degree by using this:
[code start]
Private WithEvents olInboxItems As Items
Private Sub Application_Startup()
Dim objNS As NameSpace
Set objNS = Application.GetNamespace("MAPI")
Set olInboxItems = objNS.GetDefaultFolder(olFolderInbox).Items
Set objNS = Nothing
End Sub
Private Sub olInboxItems_ItemAdd(ByVal Item As Object)
Dim objAttFld1 As MAPIFolder
Dim objAttFld2 As MAPIFolder
Dim objInbox As MAPIFolder
Dim objNS As NameSpace
Dim strAttFldName1 As String
Dim strAttFldName2 As String
Dim strProgExt As String
Dim arrExt() As String
Dim objAtt As Attachment
Dim intPos As Integer
Dim I As Integer
Dim strExt As String
Dim objDes As String
Dim objFilename As String
' #### USER OPTIONS ####
' name of Inbox subfolder containing messages with attachments
strAttFldName1 = "[Saved]"
strAttFldName2 = "[Unsaved]"
' delimited list of extensions to trap
strProgExt = "wav"
'Destination folder for saved files
objDes = "W:\"
On Error Resume Next
Set objNS = Application.GetNamespace("MAPI")
Set objInbox = objNS.GetDefaultFolder(olFolderInbox)
Set objAttFld1 = objInbox.Parent.Folders(strAttFldName1)
Set objAttFld2 = objInbox.Parent.Folders(strAttFldName2)
If Item.Class = olMail Then
If objAttFld1 Is Nothing Then
' create [Saved] folder if needed
Set objAttFld1 = objInbox.Parent.Folders.Add(strAttFldName1)
End If
If objAttFld2 Is Nothing Then
' create [Unsaved] folder if needed
Set objAttFld2 = objInbox.Parent.Folders.Add(strAttFldName2)
End If
If Not objAttFld1 Is Nothing Then
' convert delimited list of extensions to array
arrExt = Split(strProgExt, ",")
For Each objAtt In Item.Attachments
intPos = InStrRev(objAtt.FileName, ".")
If intPos > 0 Then
' check attachment extension against array
strExt = LCase(Mid(objAtt.FileName, intPos + 1))
For I = LBound(arrExt) To UBound(arrExt)
If strExt = Trim(arrExt(I)) Then
StartPrompt:
objFilename = InputBox("Please type a filename (the ticket #)
below. You do not have to include the .wav extension:", "Saving
recording...", "")
If objFilename = "" Then
Item.UnRead = True
Item.Move objAttFld2
Exit Sub
End If
'Save to destionation folder
objAtt(I).SaveAsFile objDes & _
objFilename & ".wav"
Item.UnRead = False
Item.Move objAttFld1
Exit For
End If
Next
Else
' no extension; unknown type
Item.Move objAttFld
End If
Next
End If
End If
On Error GoTo 0
Set objAttFld = Nothing
Set objInbox = Nothing
Set objNS = Nothing
Set objAtt = Nothing
End Sub
[code stop]
This is modified code found from a link in this group, and its
almost
at the point where I want it. It doesnt work off the currently
selected item, but does trigger off an

...

read more »

 

[adimax]

You are a god among men, Dmitry. Works perfectly.

Benjamin

Arghh... Sorry, replace
Left(39, Item.Subject)
with
Left(Item.Subject, 39)
I am suprised VBA idd not raise an error since I had the arguments of wrong
types in the wrong order

Dmitry Streblechenko (MVP)http://www.dimastr.com/
OutlookSpy - Outlook, CDO
and MAPI Developer Tool


It does exactly what you'd expect: pops the box up with the Subject
text (in my case 'WHY WONT YOU WORK! ARGH!', hehehe) and if I click
Ok, it goes right on through to the 2nd pop-up box asking for the file
name.

Its so frustrating because the If statement later on does work in the
sense of if I click cancel or leave the filename blank, it moves the
file to the appropriate folder/doesn't save the attachment (based on
it = "", or [blank]). I thought Ifs had an implicit else = end sub. Is
this not the case?

Any other ideas or ways to have it fire ONLY on a specific subject?
Some way to reverse the way it looks at it? If I can get this issue
resolved, the code will definitely be rolled out to the rest of the
floor.

Benjamin

Without actually running the script, looks perfectly fine to me.
Can you try to add something like

MsgBox Item.Subject

to make sure the subject is really wrong?

Dmitry Streblechenko (MVP)http://www.dimastr.com/
OutlookSpy - Outlook, CDO
and MAPI Developer Tool

news:[email protected]...

Dmitry,
I really thought we had it, but it's still not working. There are no
errors generated, but when I send myself a test email with a different
subject line, it still processes as if it met the specified subject
line/executes to the Input Box. I'm looking for it to stop processing
if the subject line doesnt match.
The exact opposite happens if I specify a sender email address. It
does not process to the Input Box and appears to be stopped cold. I've
even tried specifying my email address and sending myself an email
with a .wav attached, nothing.
Here's the full code again, tweaked a bit since last time:
[start code]
Private WithEvents olInboxItems As Items
Private Sub Application_Startup()
Dim objNS As NameSpace
Set objNS = Application.GetNamespace("MAPI")
Set olInboxItems = objNS.GetDefaultFolder(olFolderInbox).Items
Set objNS = Nothing
End Sub
Private Sub olInboxItems_ItemAdd(ByVal Item As Object)
Dim objAttFld1 As MAPIFolder
Dim objAttFld2 As MAPIFolder
Dim objInbox As MAPIFolder
Dim objNS As NameSpace
Dim strAttFldName1 As String
Dim strAttFldName2 As String
Dim strProgExt As String
Dim arrExt() As String
Dim objAtt As Attachment
Dim intPos As Integer
Dim I As Integer
Dim strExt As String
Dim objDes As String
Dim objFilename As String
' #### USER OPTIONS ####
' name of Inbox subfolder containing messages with attachments
strAttFldName1 = "[Saved]"
strAttFldName2 = "[Unsaved]"
' delimited list of extensions to trap
strProgExt = "wav"
'Destination folder for saved files
objDes = "W:\"
On Error Resume Next
Set objNS = Application.GetNamespace("MAPI")
Set objInbox = objNS.GetDefaultFolder(olFolderInbox)
Set objAttFld1 = objInbox.Parent.Folders(strAttFldName1)
Set objAttFld2 = objInbox.Parent.Folders(strAttFldName2)
If Item.Class = olMail Then
'Check Sender
'If Item.SenderEmailAddress = "(e-mail address removed)" Then
'Check Subject
If Left(39, Item.Subject) = "IC Voicemail: Call Recording (Call ID:
" Then
If objAttFld1 Is Nothing Then
' create [Saved] folder if needed
Set objAttFld1 = objInbox.Parent.Folders.Add(strAttFldName1)
End If
If objAttFld2 Is Nothing Then
' create [Unsaved] folder if needed
Set objAttFld2 = objInbox.Parent.Folders.Add(strAttFldName2)
End If
If Not objAttFld1 Is Nothing Then
' convert delimited list of extensions to array
arrExt = Split(strProgExt, ",")
For Each objAtt In Item.Attachments
intPos = InStrRev(objAtt.FileName, ".")
If intPos > 0 Then
' check attachment extension against array
strExt = LCase(Mid(objAtt.FileName, intPos + 1))
For I = LBound(arrExt) To UBound(arrExt)
If strExt = Trim(arrExt(I)) Then
StartPrompt:
objFilename = InputBox("Please type a filename (the ticket #)
below. You do not have to include the .wav extension:", "Saving
recording...", "")
If objFilename = "" Then
Item.UnRead = True
Item.Move objAttFld2
Exit Sub
End If
'Save to destination folder
objAtt.SaveAsFile objDes & _
objFilename & ".wav"
Item.UnRead = False
Item.Move objAttFld1
Exit For
End If
Next
Else
' no extension; unknown type
' Item.Move objAttFld
End If
Next
End If
End If
End If
'End If
On Error GoTo 0
Set objAttFld = Nothing
Set objInbox = Nothing
Set objNS = Nothing
Set objAtt = Nothing
End Sub
[end code]
I've also tried a
If Left (2, Item.Subject) = "IC" Then
and a
If Left(4, Item.Subject) = "test" Then
and they both do the same as the actual code.
Is it out of order somehow or can you think of any other reason this
is not running through the steps normally?
Benjamin
Use the Left() intrinsic VB function:
if Left(24 , Item.Subject) = "Call Recording (Call ID:" Then
Dmitry Streblechenko (MVP)http://www.dimastr.com/
OutlookSpy - Outlook, CDO
and MAPI Developer Tool

Dmitry,
First, thank you for the assistance. I really, really appreciate it.
You were correct on both accounts, I believe. As far as checking the
subject goes,
' If Item.Subject = "Call Recording (Call ID:" Then
is what I am using now. However, I mistyped. The above portion of the
subject for incoming emails never changes, but after the 'ID:' there
is an always changing 6 or 7-digit number. Is there a way to wildcard
the field, or do something alone the lines of: Call Recording*.*
I'll also look into filtering it by the sender. Thanks for the info
again!
Benjamin
On Aug 29, 7:58 pm, "Dmitry Streblechenko" <[email protected]>
wrote:
The subject check will be exactly the same:
If Item.Subject = "whatever" Then ...
What is the problem with the sender address? Do you get an
unexpected
value
(such as an ugly EX address rather than SMTP)? Or do you get an
error?
One thing I can see if that the Mail variable is never declared or
initialized. Did you mean Item?
Dmitry Streblechenko (MVP)http://www.dimastr.com/
OutlookSpy - Outlook, CDO
and MAPI Developer Tool

You are correct, Dmitry. The code was pieced together and hacked
up
to
suit my needs, but even then it was not what I was looking for.
I've since corrected the problem to a degree by using this:
[code start]
Private WithEvents olInboxItems As Items
Private Sub Application_Startup()
Dim objNS As NameSpace
Set objNS = Application.GetNamespace("MAPI")
Set olInboxItems = objNS.GetDefaultFolder(olFolderInbox).Items
Set objNS = Nothing
End Sub
Private Sub olInboxItems_ItemAdd(ByVal Item As Object)
Dim objAttFld1 As MAPIFolder
Dim objAttFld2 As MAPIFolder
Dim objInbox As MAPIFolder
Dim objNS As NameSpace
Dim strAttFldName1 As String
Dim strAttFldName2 As String
Dim strProgExt As String
Dim arrExt() As String
Dim objAtt As Attachment
Dim intPos As Integer
Dim I As Integer
Dim strExt As String
Dim objDes As String
Dim objFilename As String
' #### USER OPTIONS ####
' name of Inbox subfolder containing messages with attachments
strAttFldName1 = "[Saved]"
strAttFldName2 = "[Unsaved]"
' delimited list of extensions to trap
strProgExt = "wav"
'Destination folder for saved files
objDes = "W:\"
On Error Resume Next
Set objNS = Application.GetNamespace("MAPI")
Set objInbox = objNS.GetDefaultFolder(olFolderInbox)
Set objAttFld1 = objInbox.Parent.Folders(strAttFldName1)
Set objAttFld2 = objInbox.Parent.Folders(strAttFldName2)
If Item.Class = olMail Then
If objAttFld1 Is Nothing Then
' create [Saved] folder if needed
Set objAttFld1 = objInbox.Parent.Folders.Add(strAttFldName1)
End If
If objAttFld2 Is Nothing Then
' create [Unsaved] folder if needed
Set objAttFld2 = objInbox.Parent.Folders.Add(strAttFldName2)
End If
If Not objAttFld1 Is Nothing Then
' convert delimited list of extensions to array
arrExt =

...

read more »