Follow along with the video below to see how to install our site as a web app on your home screen.
Note: This feature may not be available in some browsers.
Sub SendAndFile()
On Error Resume Next
'First find the current mail object
Dim objMailItem As Object
Set objMailItem = Application.ActiveInspector.CurrentItem
Dim objNS As NameSpace
Dim objFolder As MAPIFolder
If Item.Class = olMail Then ' used to act only on mail messages
Set objNS = Application.GetNamespace("MAPI")
'Now browse to the folder to send to
Set objFolder = objNS.PickFolder
If Not objFolder Is Nothing Then
If IsInDefaultStore(objFolder) Then
'Set the folder to save in to our choice
Set objMailItem.SaveSentMessageFolder = objFolder
End If
Else
Exit Sub
End If
End If
'Send the email message
objMailItem.Send
Set objFolder = Nothing
End Sub
Public Function IsInDefaultStore(objOL As Object) As Boolean
Dim objApp As Outlook.Application
Dim objNS As Outlook.NameSpace
Dim objInbox As Outlook.MAPIFolder
On Error Resume Next
Set objApp = CreateObject("Outlook.Application")
Set objNS = objApp.GetNamespace("MAPI")
Set objInbox = objNS.GetDefaultFolder(olFolderInbox)
Select Case objOL.Class
Case olFolder
If objOL.StoreID = objInbox.StoreID Then
IsInDefaultStore = True
End If
Case olAppointment, olContact, olDistributionList, _
olJournal, olMail, olNote, olPost, olTask
If objOL.Parent.StoreID = objInbox.StoreID Then
IsInDefaultStore = True
End If
Case Else
MsgBox "This function isn't designed to work " & _
"with " & TypeName(objOL) & _
" items and will return False.", _
, "IsInDefaultStore"
End Select
Set objApp = Nothing
Set objNS = Nothing
Set objInbox = Nothing
End Function
Sub MoveToProjectFolder()
On Error Resume Next
Dim ns As Outlook.NameSpace
Dim MoveToFolder As Outlook.MAPIFolder
Dim objItem As Outlook.MailItem
Set ns = Application.GetNamespace("MAPI")
'Now browse to the folder to send to
Set MoveToFolder = ns.PickFolder
If Application.ActiveExplorer.Selection.Count = 0 Then
MsgBox ("No item selected")
Exit Sub
End If
If MoveToFolder Is Nothing Then
MsgBox "Target folder not found!", vbOKOnly + vbExclamation, "Move Macro Error"
End If
For Each objItem In Application.ActiveExplorer.Selection
If MoveToFolder.DefaultItemType = olMailItem Then
If objItem.Class = olMail Then
objItem.Move MoveToFolder
End If
End If
Next
Set objItem = Nothing
Set MoveToFolder = Nothing
Set ns = Nothing
End Sub