Re: Moving the e-mail to a seperate Folder
Putting this in the class wouldn't work.. though something could be done to do so, you're much better off putting it in your SaveSelectedEmails sub or something. Assuming that "MailFile" is a 'peer' folder of the user's Inbox, add the following to the subroutine:[vba]'put this near the top of saveselectedemails
Dim vFolder As MAPIFolder
Set vFolder = Application.Session.GetDefaultFolder(olFolderInbox).Parent.Folders("MailFil e")
'then put this in your For iItem = ... loop when you want it moved
.Items(iItem).Move vFolder[/vba]
What you'd have to do for this is have (along the same lines as your _Send event) a WithEvents variable of type Outlook.Items.. for example:[vba]Dim WithEvents ItemsInSentFolder As Outlook.Items[/vba]2)Currently the Form is activated when the send button is clicked. this is called from the clsCloseEvent Class Module. I want to put code in here to stop it working if the sent button has been clicked. I then want to activate it only if the e-mail reaches the Sent Items box as send may fail.
Then to set that, use:[vba]Set ItemsInSentFolder = Application.Session.GetDefaultFolder(olFolderSentMail)[/vba]
And to use it:[vba]Private Sub ItemsInSentFolder_ItemAdd(ByVal Item As Object)
'when a message gets added to the sent folder, this is triggered
If TypeName(Item) = "MailItem" Then
'code to run on mail items
End If
End Sub[/vba]
Re: the save-as dialog box, I thought you were giving your users the option to choose the filename too.. if you only want a folder picker, you have a couple options (these are in the knowledgebase here at vbax, I believe). The first uses APIs, like the saveas above. In this case you really only need from the Type statement down, the constants at the top are just for reference:[vba]'Using the windows APIs, this gives you a dialog to select a folder on the computer
' There are many different options at the top you can use for the ulFlags property
' in the GetDirectory function
'
'***** ulFlags options *****
'** to use multiple flags, either:
' -use the OR operator, like BIF_NEWDIALOGSTYLE Or BIF_RETURNONLYFSDIRS
' -add the hex values, like &H41 (&H40 + &H1)
'
'&H1000
'Only return computers. If the user selects anything other than a computer, the
'OK button is grayed.
Private Const BIF_BROWSEFORCOMPUTER = &H1000
'&H2000
'Only return printers. If the user selects anything
'other than a printer, the OK button is grayed.
Private Const BIF_BROWSEFORPRINTER = &H2000
'&H4000
'The browse dialog will display files as well as folders.
Private Const BIF_BROWSEINCLUDEFILES = &H4000
'&H2
'Do not include network folders below the domain level in the tree view control.
Private Const BIF_DONTGOBELOWDOMAIN = &H2
'&H10
'Include an edit control in the dialog box.
Private Const BIF_EDITBOX = &H10
'&H40
'Use the new user-interface providing the user with a larger resizable dialog box
'which includes drag and drop, reordering, context menus, new folders, delete, and
'other context menu commands.
Private Const BIF_NEWDIALOGSTYLE = &H40
'&H8
'Only return file system ancestors. If the user selects anything other than a file
'system ancestor, the OK button is grayed.
Private Const BIF_RETURNFSANCESTORS = &H8
'&H1
'Only return file system directories. If the user selects folders that are not part
'of the file system, the OK button is grayed.
Private Const BIF_RETURNONLYFSDIRS = &H1
'&H4
'Include a status area in the dialog box. The callback function can set the status
'text by sending messages to the dialog box.
Private Const BIF_STATUSTEXT = &H4
Type BROWSEINFO
hOwner As Long
pidlRoot As Long
pszDisplayName As String
lpszTitle As String
ulFlags As Long
lpfn As Long
lParam As Long
iImage As Long
End Type
Declare Function SHGetPathFromIDList Lib "shell32.dll" Alias "SHGetPathFromIDListA" _
(ByVal pidl As Long, ByVal pszPath As String) As Long
Declare Function SHBrowseForFolder Lib "shell32.dll" Alias "SHBrowseForFolderA" _
(lpBrowseInfo As BROWSEINFO) As Long
Option Explicit
Public Function GetDirectory(Optional Msg) As String
Dim bInfo As BROWSEINFO, path As String, r As Long, x As Long, pos As Integer
bInfo.pidlRoot = 0&
If IsMissing(Msg) Then
bInfo.lpszTitle = "Select a folder."
Else
bInfo.lpszTitle = Msg
End If
bInfo.ulFlags = &H51 'use hex or constants
x = SHBrowseForFolder(bInfo)
path = Space$(512)
r = SHGetPathFromIDList(ByVal x, ByVal path)
If r Then pos = InStr(path, CHR$(0)): GetDirectory = Left$(path, pos - 1)
End Function
Sub ExampleSubForGetDirectory()
Debug.Print GetDirectory("hi")
End Sub[/vba]
That gives you a ton of flexibility over what you can do with it.. however if you simply want a folder picker, check out the BrowseForFolder method of the shell object:[vba] Dim ShellApp As Object, shFolder As Object, shFolderName As String
Set sa = CreateObject("Shell.Application")
Set shFolder = sa.BrowseForFolder(0, "Select Folder to Save Output File", 0, "")
If shFolder Is Nothing Then Exit Sub 'cancel
shFolderName = shFolder.Items.Item.Path & "\"
MsgBox shFolderName
Set ShellApp = Nothing
Set shFolder = Nothing[/vba]
Sorry about the delay in getting back to you, went to canada over the weekend with some friends and then last night went to my father's house.