How to specify non-default public folders - vba

I want to create a macro, that allows for copying currently selected folder into a public (shared) folder.
Sub CopyFolder()
Dim myNameSpace As Outlook.NameSpace
Dim myInboxFolder As Outlook.Folder
Dim myToBeCopiedFolder As Outlook.Folder
Dim myNewFolder As Outlook.Folder
Dim TopPublicFolder As Object
Set TopPublicFolder = myNameSpace.GetDefaultFolder(olPublicFoldersAllPublicFolders)
Set myNameSpace = Application.GetNamespace("MAPI")
Set myInboxFolder = TopPublicFolder.Folders("Office emails")
Set myToBeCopiedFolder = Application.ActiveExplorer.CurrentFolder
Set myNewFolder = myContactsFolder.CopyTo(myInboxFolder)
End Sub
Currently, I am getting run-time error 91, and to be honest, no idea why.


There is no myContactsFolder object declared in the code:
Sub CopyFolder()
Dim myNameSpace As Outlook.NameSpace
Dim myInboxFolder As Outlook.Folder
Dim myToBeCopiedFolder As Outlook.Folder
Dim myNewFolder As Outlook.Folder
Dim TopPublicFolder As Object
Set myNameSpace = Application.GetNamespace("MAPI")
Set TopPublicFolder = myNameSpace.GetDefaultFolder(olPublicFoldersAllPublicFolders)
Set myNameSpace = Application.GetNamespace("MAPI")
Set myInboxFolder = TopPublicFolder.Folders("Office emails")
Set myToBeCopiedFolder = Application.ActiveExplorer.CurrentFolder
Set myNewFolder = myToBeCopiedFolder.CopyTo(myInboxFolder)
End Sub

Related

How to search for a folder using text in folder.description?

I want to find an Outlook folder using folder.description value.
In folder.description I have more than one value. The code should take only one.
Private Sub CLemailbackupsaved_Click()
Dim olApp As Outlook.Application
Dim olNS As Outlook.Namespace
Dim olFldr As Outlook.MAPIFolder
Dim objfolder As Outlook.MAPIFolder
Dim olItem As Object
Dim olMailItem As Outlook.MailItem
Dim intx As Long
'Dim reportid As String
Set olApp = New Outlook.Application
Set olNS = olApp.GetNamespace("MAPI")
Set olFldr = olNS.Folders("a#a.com")
Set olFldr = olFldr.Folders("Inbox")
Debug.Print olFldr.Name
For intx = 1 To olFldr.Folders.Count
If olFldr.Folders.Item(intx).Description = "* MR090 *" Then
Set objfolder = olFldr.Folders.Item(intx)
Exit For
End If
Next
Debug.Print objfolder.Name
Set olNS = Nothing
Set objfolder = Nothing
Set olFldr = Nothing
Set olApp = Nothing
End Sub
Folder.description example value:
MR091 MR090

Type Mismatch Error when referencing Folder with PickFolder

The following is supposed to launch a popup folder picker, and then move the current item to the selected folder.
Sub MoveItems()
Dim myNameSpace As Outlook.NameSpace
Dim myInbox As Outlook.Folder
Dim mySubFolder As Outlook.Folder
Dim myDestFolder As Outlook.Folder
Dim myItem As Object
Set myNameSpace = Application.GetNamespace("MAPI")
Set myInbox = myNameSpace.GetDefaultFolder(olFolderInbox)
Set mySubFolder = myNameSpace.PickFolder
Set myDestFolder = myInbox.Folders(mySubFolder)
Set myItem = GetCurrentItem()
myItem.Move myDestFolder
End Sub
I am getting a Type Mismatch on the line
Set myDestFolder = myInbox.Folders(mySubFolder)

That line should be Set myDestFolder = mySubFolder
You may wanna also use If mySubFolder Is Nothing Then Exit Sub just in case user decides to cancel the myNameSpace.PickFolder so you don't get run-time error
Option Explicit
Sub MoveItems()
Dim myNameSpace As Outlook.NameSpace
Dim myInbox As Outlook.Folder
Dim mySubFolder As Outlook.Folder
Dim myDestFolder As Outlook.Folder
Dim myItem As Object
Set myNameSpace = Application.GetNamespace("MAPI")
Set myInbox = myNameSpace.GetDefaultFolder(olFolderInbox)
Set mySubFolder = myNameSpace.PickFolder
If mySubFolder Is Nothing Then Exit Sub
Set myDestFolder = mySubFolder
Set myItem = GetCurrentItem()
myItem.Move myDestFolder
End Sub
Function GetCurrentItem() As Object
Dim objApp As Outlook.Application
Set objApp = Application
On Error Resume Next
Select Case TypeName(objApp.ActiveWindow)
Case "Explorer"
Set GetCurrentItem = objApp.ActiveExplorer.Selection.Item(1)
Case "Inspector"
Set GetCurrentItem = objApp.ActiveInspector.CurrentItem
End Select
Set objApp = Nothing
End Function
IsNothing Function
IsNothing returns True if the expression represents an object variable that currently has no object assigned to it; otherwise, it returns False.

Reference a shared inbox account

On a shared inbox account, I would like to run a script if the email is unread.
I tried this:
Sub UnreadMail()
Dim myEmail As Object
Dim myNamespace As Object
Dim myFolder As Folder
Set myNamespace = Application.GetNamespace("MAPI")
Set myFolder = myNamespace.GetDefaultFolder(olFolderInbox)
For Each myEmail In myFolder
If (myEmail.UnRead) Then
Call SaveAttachToDisk
End If
Next
End Sub

You almost got it, Try using GetSharedDefaultFolder Look at MSDN GetSharedDefaultFolder Method
Option Explicit
Sub UnreadMail()
Dim olNameSpace As Outlook.NameSpace
Dim olShareName As Outlook.Recipient
Dim olShareInbox As Outlook.Folder
Dim olItem As Outlook.MailItem
Set olNameSpace = Application.GetNamespace("MAPI")
Set olShareName = olNameSpace.CreateRecipient("Om3r#Email.com") 'address
Set olShareInbox = olNameSpace.GetSharedDefaultFolder(olShareName, olFolderInbox) 'Inbox
For Each olItem In olShareInbox.Items
If (olItem.UnRead) Then
'Call SaveAttachToDisk
Debug.Print olItem '// Print UnRead Item to Immediate window
End If
Next
End Sub

Copy a personal contact list to a public folder

I made code to copy a contact list to a public folder but if I am not on the contact source it does not work.
Sub Movecopycontacts()
Dim objOutlook As Outlook.Application
Dim objNamespace As Outlook.NameSpace
Dim objSourceFolder As Outlook.MAPIFolder
Dim objDestFolder As Outlook.MAPIFolder
Dim objItem As ContactItem
Set objOutlook = Application
Set objNamespace = objOutlook.GetNamespace("MAPI")
Set objSourceFolder = objNamespace.GetDefaultFolder(olFolderContacts)
Set objItem = Application.ActiveExplorer.Selection.Item(1)
Set objDestFolder = objNamespace.Folders("Public folder - oky#test.com").Folders("all public folder").Folders("test")
objItem.Move objDestFolder
Set objDestFolder = Nothing
End Sub
The error comes from:
Set objItem = Application.ActiveExplorer.Selection.Item(1)

That is correct - your code assumes that the item to be moved is selected. It does what it is supposed to do.
\What else do you want it to do?

Reference a folder by name

I need to get a folder by name, not by folder number counts. I tried getting with various methods.
Dim olApp As Outlook.Application
Dim objNS As Outlook.NameSpace
'Dim OlFolder As Outlook.MAPIFolder
Dim objFolder As Outlook.Folder
Dim myolItems As Outlook.Items
Set olApp = Outlook.Application
Set objNS = olApp.GetNamespace("MAPI")
'Set myOlItems = objNS.GetDefaultFolder(37).Folders("Vijay Baswal").Items
'Open the folder
Set objFolder = olApp.Session.GetDefaultFolder("Vijay Baswal")

Say under the Inbox was a folder named Clients and under that was a folder named Vijay Baswal
Set objFolder = objNS.GetDefaultFolder(olFolderInbox).Folders("Clients").Folders("Vijay Baswal")
OlDefaultFolders Enumeration http://msdn.microsoft.com/en-us/library/office/bb208072(v=office.12).aspx
The Inbox is olFolderInbox or 6. Appears there is no 37.

see below vba snippet to check how to read mail from specific folder
Dim olApp As Outlook.Application
Dim olNs As Outlook.NameSpace
Dim olFldr As Outlook.MAPIFolder
Dim olItms As Outlook.Items
Dim olMail As Variant
Dim outFolder As Outlook.Folder
Dim olItem As Outlook.MailItem
Dim i As Long
Set olApp = New Outlook.Application
Set olNs = olApp.GetNamespace("MAPI")
Set olFldr = olNs.Folders("folder1").Folders("fol2")
Set olItms = olFldr.Items
olItms.Sort "Subject"
i = 1
For Each olItem In olItms
'If InStr(olMail.Subject, "Criteria") > 0 Then
Dim szVar As String
szVar = olItem.Body
szVar1 = olItem.Subject
i = i + 1
'End If
Next olItem
Set olFldr = Nothing
Set olNs = Nothing
Set olApp = Nothing