![]() |
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. |
|
|
Thread Tools | Search this Thread | Display Modes |
#1
|
|||
|
|||
![]()
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 |
Display Modes | |
|
|
![]() |
||||
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 |