A Microsoft Outlook email forum. Outlook Banter

If this is your first visit, be sure to check out the FAQ by clicking the link above. You may have to register before you can post: click the register link above to proceed. To start viewing messages, select the forum that you want to visit from the selection below.

Go Back   Home » Outlook Banter forum » Microsoft Outlook Email Newsgroups » Outlook and VBA
Site Map Home Register Authors List Search Today's Posts Mark Forums Read Web Partners

Looking for code to wait/pause for input...



 
 
Thread Tools Search this Thread Display Modes
Prev Previous Post   Next Post Next
  #1  
Old February 26th 08, 12:48 PM posted to microsoft.public.outlook.program_vba
[email protected]
external usenet poster
 
Posts: 22
Default Looking for code to wait/pause for input...

This code is a few months old (and was put together here with the help
of some very awesome posters), and I've been recently commissioned to
upgrade it.

How it's working now is to watch the Inbox for any emails (with a
specific Subject and with a .wav attachment), and then it fires an
InputBox and if the field is empty, the user clicks cancel, or the
user clicks the X in the corner, the message is not marked as read and
is moved to Unsaved.

or

If the user inputs any data then the attached .wav file is saved with
the entered data, the message is marked read, and its then moved to
the Saved folder.

The code that does the above is working and follows:

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

' version 1.6
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

On Error Resume Next

Dim strTimeStamp As String
Dim objDes As String
Dim objFilename As String

' set the Inbox subfolders where messages w/ .wav attachments will
be moved to
strAttFldName1 = "[Saved Recordings]"
strAttFldName2 = "[Unsaved Recordings]"

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

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

' 1st check if the correct folders are in place (non-triggered)
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
End If


' 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

' set destination folder for saved files
objDes = "W:\"

' checks subject of incoming email
If Left(Item.Subject, 39) = "New Sound Recording: " Then

' 2nd check if the correct folders are in place (triggered)
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

' sets the popup box properties

StartPrompt:
objFilename = InputBox("Please type a filename 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 with inputted ticket # as a filename
+ timestamp
objAtt.SaveAsFile objDes & _
objFilename & " @ " & strTimeStamp & ".wav"

Item.UnRead = False
Item.Move objAttFld1

Exit For
End If
Next
Else
' no extension; unknown type; clicked Cancel or left
filename field blank
End If
Next
End If
End If
End If

' clear variables
Set objInbox = Nothing
Set objNS = Nothing
Set objAtt = Nothing

Exit Sub

' ErrorHandling:
' display the error's description
' MsgBox Err.Description, vbExclamation

End Sub

---end code---

The problem I am having is that we want to switch over to a userform
and add a few more options to the filename that gets generated and
saved (like what type of recording, inbound or outbound, etc). I think
I can code all of that pretty easily, but its getting the userform to
trigger in the above code and then wait for input/make a decision
based on that input (to save and mark read and move or to not save,
not mark read, and move).

Right now the code looks like (with objFilename being adjusted to
Filename):

---start code---

' sets the popup box properties

Call OpenUserForm
If Filename = "" Then
Item.UnRead = True
Item.Move objAttFld2
Exit Sub
End If

(and the code to OpenUserForm, though its pretty simple)

Private Sub OpenUserForm()
Show.PopUpBox
End Sub

---end code---

This actually does execute when I do a test by moving a message into
the Inbox with a .wav, but it immediately takes the message and marks
it read and puts it in the Unsaved folder. I never even see the
userform... and yet I get no errors, either... oddly.

I guess what I am looking for is some advice on getting the PopUpBox
userform to open based on the filename field it exectues the rest of
the moving/marking/saving code.

Thanks in advance, I know this is (or seems to me!) a complicated one.

Benjamin
 




Thread Tools Search this Thread
Search this Thread:

Advanced Search
Display Modes

Posting Rules
You may not post new threads
You may not post replies
You may not post attachments
You may not edit your posts

vB code is On
Smilies are On
[IMG] code is On
HTML code is Off
Forum Jump

Similar Threads
Thread Thread Starter Forum Replies Last Post
Outlook Script: insert a pause in do while bbnimda Outlook - Using Forms 0 December 14th 07 09:31 AM
need help with vba code to input data on certain date and move to next cell for the following date. [email protected] Outlook and VBA 1 May 30th 07 04:45 PM
Outlook seems to pause/freeze once in a while while reading e-mails. Phillip Pi Outlook - General Queries 2 May 16th 06 01:20 AM
How do I programme a pause in a number dialed from contacts? timbrownsc Outlook - Using Contacts 0 April 18th 06 03:56 PM
pause in script Joel Allen Outlook and VBA 6 February 27th 06 06:28 AM


All times are GMT +1. The time now is 03:36 PM.


Powered by vBulletin® Version 3.6.4
Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.Search Engine Friendly URLs by vBSEO 2.4.0
Copyright ©2004-2025 Outlook Banter.
The comments are property of their posters.