Item.ReceivedTime issues/possible work around?

[adimax]

Several weeks ago I worked with Dmitry from these groups to resolve
some issues I had with some code. After we hammered out all the bugs
and such, it worked fine for me with no errors for a few weeks.

However, now that this code has been released to a large number of
users (90+), they are (rarely) reporting a problem that seems
difficult to recreate. When the users go ahead and choose the debug
option it always highlights in yellow this line:

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

and I'm not 100% sure what is triggering it. Is it possibly bad emails
on the exchange server, somehow with a screwed up RecievedTime? I've
been trying to get them to forward me the last email that caused this,
but we'll have to wait on that.

Would there be anything I could add to this code that would
essentially look like:

1. Try to get the timestamp info for RecievedTime from the mail
message,
2. if this fails, continue on with the code and do no worry about
adding the timestamp info to the file name of the saved file

I know it would use some sort of If/Then but I'm not sure what to
compare the RecievedTime value (or error) to.

I know this is kinda out there and broad, but any help would be
greatly appreciated.

Entire code follows:
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

 

[Michael Bauer [MVP - Outlook]]

Without knowing the error message, I suppose it's that the Item object
doesn't support the ReceivedTime property. In that case simply check the
item's type beforehand. E.g.:

If TypefOf Item Is Outlook.MailItem Then
' ok
Endif

--
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 Sun, 30 Sep 2007 20:30:09 -0000 schrieb (e-mail address removed):

Several weeks ago I worked with Dmitry from these groups to resolve
some issues I had with some code. After we hammered out all the bugs
and such, it worked fine for me with no errors for a few weeks.

However, now that this code has been released to a large number of
users (90+), they are (rarely) reporting a problem that seems
difficult to recreate. When the users go ahead and choose the debug
option it always highlights in yellow this line:

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

and I'm not 100% sure what is triggering it. Is it possibly bad emails
on the exchange server, somehow with a screwed up RecievedTime? I've
been trying to get them to forward me the last email that caused this,
but we'll have to wait on that.

Would there be anything I could add to this code that would
essentially look like:

1. Try to get the timestamp info for RecievedTime from the mail
message,
2. if this fails, continue on with the code and do no worry about
adding the timestamp info to the file name of the saved file

I know it would use some sort of If/Then but I'm not sure what to
compare the RecievedTime value (or error) to.

I know this is kinda out there and broad, but any help would be
greatly appreciated.

Entire code follows:
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

 

[adimax]

Gotcha. And this has got to be a very stupid question, but how do you
get the specific error message?

Without knowing the error message, I suppose it's that the Item object
doesn't support the ReceivedTime property. In that case simply check the
item's type beforehand. E.g.:

If TypefOf Item Is Outlook.MailItem Then
' ok
Endif

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

Am Sun, 30 Sep 2007 20:30:09 -0000 schrieb (e-mail address removed):

Several weeks ago I worked with Dmitry from these groups to resolve
some issues I had with some code. After we hammered out all the bugs
and such, it worked fine for me with no errors for a few weeks.

However, now that this code has been released to a large number of
users (90+), they are (rarely) reporting a problem that seems
difficult to recreate. When the users go ahead and choose the debug
option it always highlights in yellow this line:

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

and I'm not 100% sure what is triggering it. Is it possibly bad emails
on the exchange server, somehow with a screwed up RecievedTime? I've
been trying to get them to forward me the last email that caused this,
but we'll have to wait on that.

Would there be anything I could add to this code that would
essentially look like:

1. Try to get the timestamp info for RecievedTime from the mail
message,
2. if this fails, continue on with the code and do no worry about
adding the timestamp info to the file name of the saved file

I know it would use some sort of If/Then but I'm not sure what to
compare the RecievedTime value (or error) to.

I know this is kinda out there and broad, but any help would be
greatly appreciated.

Entire code follows:
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

 

[Michael Bauer [MVP - Outlook]]

If a code line is highlighted due to an error then you don't have any kind
of error handling. Then the code executions stops and VBA displays a prompt
with the error message.

There is different methods of error handling. E.g.:

sub abc()
On Error Goto AnyName
' code here
' ...
' no error, leave the procdure
Exit Sub
AnyName:
' error, display its description
MsgBox Err.Description, vbExclamation
end sub

--
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 Mon, 01 Oct 2007 16:05:01 -0000 schrieb (e-mail address removed):

Gotcha. And this has got to be a very stupid question, but how do you
get the specific error message?

Without knowing the error message, I suppose it's that the Item object
doesn't support the ReceivedTime property. In that case simply check the
item's type beforehand. E.g.:

If TypefOf Item Is Outlook.MailItem Then
' ok
Endif

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

Am Sun, 30 Sep 2007 20:30:09 -0000 schrieb (e-mail address removed):

Several weeks ago I worked with Dmitry from these groups to resolve
some issues I had with some code. After we hammered out all the bugs
and such, it worked fine for me with no errors for a few weeks.

However, now that this code has been released to a large number of
users (90+), they are (rarely) reporting a problem that seems
difficult to recreate. When the users go ahead and choose the debug
option it always highlights in yellow this line:

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

and I'm not 100% sure what is triggering it. Is it possibly bad emails
on the exchange server, somehow with a screwed up RecievedTime? I've
been trying to get them to forward me the last email that caused this,
but we'll have to wait on that.

Would there be anything I could add to this code that would
essentially look like:

1. Try to get the timestamp info for RecievedTime from the mail
message,
2. if this fails, continue on with the code and do no worry about
adding the timestamp info to the file name of the saved file

I know it would use some sort of If/Then but I'm not sure what to
compare the RecievedTime value (or error) to.

I know this is kinda out there and broad, but any help would be
greatly appreciated.

Entire code follows:
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

 

[adimax]

I appreciate it, Michael. I'll incorporate the error handling code
into all of my scripts, that's one very useful piece of code!

I also just encapsulated the timestamp code with a check to see if the
item was indeed a piece of mail...

---code---

' check to see if the item is an email prior to executing timestamp
method
If Item.Class = olMail Then

' set the timestamp method & extract it from the email
strTimeStamp = Format(Item.ReceivedTime, "hh.mm AM/PM")

End If

---end code---

Duplicating the step prior to checking the subject line. So far, so
good... but if it goes bad, at least I'll have an error message now.

Thanks for everything, Michael.

Benjamin

If a code line is highlighted due to an error then you don't have any kind
of error handling. Then the code executions stops and VBA displays a prompt
with the error message.

There is different methods of error handling. E.g.:

sub abc()
On Error Goto AnyName
' code here
' ...
' no error, leave the procdure
Exit Sub
AnyName:
' error, display its description
MsgBox Err.Description, vbExclamation
end sub

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

Am Mon, 01 Oct 2007 16:05:01 -0000 schrieb (e-mail address removed):

Gotcha. And this has got to be a very stupid question, but how do you
get the specific error message?

Without knowing the error message, I suppose it's that the Item object
doesn't support the ReceivedTime property. In that case simply check the
item's type beforehand. E.g.:
If TypefOf Item Is Outlook.MailItem Then
' ok
Endif
--
Viele Gruesse / Best regards
Michael Bauer - MVP Outlook
Organize eMails:
<http://www.vboffice.net/product.html?id=2006063&cmd=detail=en&pub=6>
Am Sun, 30 Sep 2007 20:30:09 -0000 schrieb (e-mail address removed):
Several weeks ago I worked with Dmitry from these groups to resolve
some issues I had with some code. After we hammered out all the bugs
and such, it worked fine for me with no errors for a few weeks.
However, now that this code has been released to a large number of
users (90+), they are (rarely) reporting a problem that seems
difficult to recreate. When the users go ahead and choose the debug
option it always highlights in yellow this line:
strTimeStamp = Format(Item.ReceivedTime, "hh.mm AM/PM")
and I'm not 100% sure what is triggering it. Is it possibly bad emails
on the exchange server, somehow with a screwed up RecievedTime? I've
been trying to get them to forward me the last email that caused this,
but we'll have to wait on that.
Would there be anything I could add to this code that would
essentially look like:
1. Try to get the timestamp info for RecievedTime from the mail
message,
2. if this fails, continue on with the code and do no worry about
adding the timestamp info to the file name of the saved file
I know it would use some sort of If/Then but I'm not sure what to
compare the RecievedTime value (or error) to.
I know this is kinda out there and broad, but any help would be
greatly appreciated.
Entire code follows:
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