This is a bit of code I'm quite happy with, and was pieced together
from this NG/links from this NG and with the help of Dmitry, from this
NG.

However, after extensive testing, I did come across a small issue.
When the code is triggered (by the Private WithEvents olInboxItems As
Items), it pops the pop-up box for a filename, but if while the code/
Outlook is waiting for that filename a 2nd email comes in with a .wav
attachment, the code does NOT execute after it resumes upon a filename
being entered for the 2nd email.

That may be hard to follow, so I'll break it down:

1. Email arrives with the targeted subject and a .wav attached.
2. Code triggers. Asks for a filename.
3. If another email with the target subject and a .wav comes in,
before Cancel has been clicked or a filename has been entered on the
1st emails InputBox, it sits in the Inbox.
4. Filename/Cancel is entered, 1st email and the rest of the code
executes flawlessly.
5. The end. No attempt is then made to look at the 2nd (3rd, 4th, etc)
emails in the Inbox.

I guess I'm just looking for a way to loop or refresh the trigger.
I've dug around in Outlook help and on here, but I'm not finding what
I'm looking for.

Thanks in advance,
Benjamin

[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 strTimeStamp As String
Dim objDes As String
Dim objFilename As String

' name of Inbox subfolder containing messages with attachments
strAttFldName1 = "[Saved Recordings]"
strAttFldName2 = "[Unsaved Recordings]"

' delimited list of extensions to trap
strProgExt = "wav"

'timestamp
strTimeStamp = Format(Item.ReceivedTime, "hh.mm AM/PM")

'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)

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

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 destination folder
objAtt.SaveAsFile objDes & _
objFilename & " @ " & strTimeStamp & ".wav"

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

On Error GoTo 0

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

End Sub

That's the way it works. If you want to stick with the itemAdd event you'd
need a much more complex multithreaded design, which isn't possible with
VBA.

Instead, use a timer and loop in intervals through the folder and look for
new/unread items.

--
Viele Gruesse / Best regards
Michael Bauer - MVP Outlook
Organize eMails:
http://www.vboffice.net/product.html?id=2006063&cmd=detail&lang=en&pub=6

Am Thu, 06 Sep 2007 18:10:14 -0000 schrieb :

This is a bit of code I'm quite happy with, and was pieced together
from this NG/links from this NG and with the help of Dmitry, from this
NG.

However, after extensive testing, I did come across a small issue.
When the code is triggered (by the Private WithEvents olInboxItems As
Items), it pops the pop-up box for a filename, but if while the code/
Outlook is waiting for that filename a 2nd email comes in with a .wav
attachment, the code does NOT execute after it resumes upon a filename
being entered for the 2nd email.

That may be hard to follow, so I'll break it down:

1. Email arrives with the targeted subject and a .wav attached.
2. Code triggers. Asks for a filename.
3. If another email with the target subject and a .wav comes in,
before Cancel has been clicked or a filename has been entered on the
1st emails InputBox, it sits in the Inbox.
4. Filename/Cancel is entered, 1st email and the rest of the code
executes flawlessly.
5. The end. No attempt is then made to look at the 2nd (3rd, 4th, etc)
emails in the Inbox.

I guess I'm just looking for a way to loop or refresh the trigger.
I've dug around in Outlook help and on here, but I'm not finding what
I'm looking for.

Thanks in advance,
Benjamin

[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 strTimeStamp As String
Dim objDes As String
Dim objFilename As String

' name of Inbox subfolder containing messages with attachments
strAttFldName1 = "[Saved Recordings]"
strAttFldName2 = "[Unsaved Recordings]"

' delimited list of extensions to trap
strProgExt = "wav"

'timestamp
strTimeStamp = Format(Item.ReceivedTime, "hh.mm AM/PM")

'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)

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

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 destination folder
objAtt.SaveAsFile objDes & _
objFilename & " @ " & strTimeStamp & ".wav"

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

On Error GoTo 0

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

End Sub