if there is that folder pass else create it - vba

I would like to create a code if there is a folder in outlook than just pass and run the rest of the code else create the folder than just run the rest of the code
If objFolder Is Nothing Then
objFolder = objNS.GetDefaultFolder(Outlook.OlDefaultFolders.olFolderInbox)
objFolder = objFolder.Folders.Add("test", Outlook.OlDefaultFolders.olFolderInbox)
End If

https://learn.microsoft.com/en-us/office/vba/language/reference/user-interface-help/object-required-error-424
You're not using Set to assign objFolder
In VBA Set is required when assigning objects to a variable.
See: What does the keyword Set actually do in VBA?

As already mentioned, you need to use the keyword Set to assign an object to a variable. The following code will first check whether the folder already exists. If not, it creates one.
Dim objFolder As Outlook.Folder
Dim objTestFolder As Outlook.Folder
Set objFolder = objNS.GetDefaultFolder(Outlook.OlDefaultFolders.olFolderInbox)
On Error Resume Next
Set objTestFolder = objFolder.Folders("test")
If objTestFolder Is Nothing Then
Set objTestFolder = objFolder.Folders.Add("test", Outlook.OlDefaultFolders.olFolderInbox)
End If
On Error GoTo 0

Typically you should use the following construction:
If obj Is Nothing Then
' need to initialize obj: '
Set obj = ...
Else
' obj already set / initialized. '
End If
So, use the following code instead:
Sub MoveItems()
Dim myNameSpace As Outlook.NameSpace
Dim myInbox As Outlook.Folder
Dim myDestFolder As Outlook.Folder
Dim myitems As Outlook.Items
Dim myitem As Object
Dim objApp As Outlook.Application
Dim objFolder As Outlook.Folder
Dim objTestFolder As Outlook.Folder
Set myNameSpace = Application.GetNamespace("MAPI")
Set myInbox = myNameSpace.GetDefaultFolder(Outlook.OlDefaultFolders.olFolderInbox)
On Error Resume Next
Set objTestFolder = myInbox.Folders("test")
If objTestFolder Is Nothing Then
Set myDestFolder = myInbox.Folders.Add("test", Outlook.OlDefaultFolders.olFolderInbox)
End If
On Error GoTo 0
Set oDeletedItems = Application.Session.GetDefaultFolder(olFolderDeletedItems)
Set myitems = oDeletedItems.Items
Debug.Print myitems.Count
For I = myitems.Count To 1 Step -1
myitems.Item(I).Move myDestFolder
Next
End Sub

Related

Reference a folder not under the default inbox

I've tried countless ways of deleting items from a custom folder called "Spam Digests" older than 14 days. I have successfully done this when I nest this folder underneath the olDefaultFolder(Inbox) but when I have it outside of the default inbox, I cannot reference it as I receive object not found.
Here is what I have and I cannot seem to figure out why the object is not found when referencing "fldSpamDigest"
Dim outapp As Outlook.Application
Set outapp = CreateObject("outlook.application")
Dim olitem As Object
Dim fldSpamDigest As Outlook.MAPIFolder
Set fldSpamDigest = outapp.GetNamespace("MAPI").Folders("Spam Digests")
For Each olitem In fldSpamDigest.Items
If DateDiff("d", olitem.CreationTime, Now) > 14 Then olitem.Delete
Next
Set fldSpamDigest = Nothing
Set olitem = Nothing
Set outapp = Nothing
GetDefaultFolder(olFolderInbox) is a shortcut.
You can reference any folder the long way.
Sub reference_walk_the_path()
Dim outapp As Outlook.Application
Set outapp = CreateObject("outlook.application")
Dim olitem As Object
Dim fldSpamDigest As Outlook.MAPIFolder
' from the default inbox to the parent which is your mailbox
Set fldSpamDigest = outapp.GetNamespace("MAPI").GetDefaultFolder(olFolderInbox).Parent
' from the mailbox to a folder at the same level as the Inbox
Set fldSpamDigest = fldSpamDigest.folders("Spam Digests")
' or
' directly from the mailbox to a folder at the same level as the Inbox
'Set fldSpamDigest = outapp.GetNamespace("MAPI").folders("your email address").folders("Spam Digests")
For Each olitem In fldSpamDigest.Items
If dateDiff("d", olitem.CreationTime, Now) > 14 Then olitem.Delete
Next
Set fldSpamDigest = Nothing
Set olitem = Nothing
Set outapp = Nothing
End Sub
Dim outapp As Outlook.Application
Set outapp = CreateObject("outlook.application")
There is no need to create a new Outlook Application instance in the Outlook VBA, simply use the Application property
To reference a folder that is not under default Inbox - example would be
Option Explicit
Public Sub Example()
Dim olNs As Outlook.NameSpace
Set olNs = Application.Session
Dim Digest_Fldr As Outlook.MAPIFolder
Set Digest_Fldr = olNs.GetDefaultFolder(olFolderInbox) _
.Parent.Folders("fldSpamDigest")
Dim Items As Outlook.Items
Set Items = Digest_Fldr.Items
Dim i As Long
For i = Items.Count To 1 Step -1
DoEvents
Debug.Print Items(i).Subject
Next
End Sub

Reference to non-default non-English inbox

I am trying set a reference to a non-default inbox in MS Outlook. I have found a code in SO,
Dim objNS As Outlook.NameSpace
Dim objFolder As Outlook.MAPIFolder
Set objNS = GetNamespace("MAPI")
Set objFolder = objNS.Folders("Procurement, Request")
Set objFolder = objFolder.Folders("Inbox")
which is OK when inbox is named "Inbox".
There is a possibility for inboxes to be named in non-English languages.
You may refer to the default inbox by
objNS.getdefaultfolder(6)
But what about non-defaults?
You should be able to get inboxes by Store index or name.
Option Explicit
Sub Inbox_by_Store()
Dim allStores As Stores
Dim storeInbox As Folder
Dim i As Long
Set allStores = Session.Stores
For i = 1 To allStores.count
Debug.Print i & " DisplayName - " & allStores(i).DisplayName
Set storeInbox = Nothing
On Error Resume Next
Set storeInbox = allStores(i).GetDefaultFolder(olFolderInbox)
On Error GoTo 0
If Not storeInbox Is Nothing Then
storeInbox.Display
End If
Next
ExitRoutine:
Set allStores = Nothing
Set storeInbox = Nothing
End Sub

Select Outlook Folder With Excel VBA

I'm trying to bypass having to select the folder I want and just tell Excel to go ahead and count the "Inbox"
Sub Get_Emails()
Dim OLF As Outlook.MAPIFolder
Dim EmailItemCount As Long
Set OLF = GetObject("", "Outlook.Application").GetNamespace("MAPI").PickFolder
EmailItemCount = OLF.Items.Count
Range("A1") = EmailItemCount
Set OLF = Nothing
Application.StatusBar = False
End Sub
Does anyone know how I can just get the count without having to select the folder? Excel VBA should just automatically go into the "Inbox" and give me my count.
Note: You have to go to Tools > References > and select "Microsoft Outlook 14.0 Object Library" in order for this macro to work.
Here is something that works:
Option Explicit
Sub LoopFoldersInInbox()
Dim ns As Outlook.Namespace
Dim myfolder As Outlook.Folder
Dim mysubfolder As Outlook.Folder
Set ns = GetObject("", "Outlook.Application").GetNamespace("MAPI")
Set myfolder = ns.GetDefaultFolder(olFolderInbox)
For Each mysubfolder In myfolder.Folders
Debug.Print mysubfolder.name
Debug.Print mysubfolder.Items.Count
Next mysubfolder
End Sub
With some credits here. It is with early binding. Thus, if you press the dot in ns or mysubfolder you will see the properties and the actions they have:
Here is the late binding, thus you do not need to refer to the Outlook Library explicitly and the code would work on more users:
Option Explicit
Sub LoopFoldersInInbox()
Dim ns As Object
Dim objFolder As Object
Dim objSubfolder As Object
Set ns = GetObject("", "Outlook.Application").GetNamespace("MAPI")
Set objFolder = ns.GetDefaultFolder(6) ' 6 is equal to olFolderInbox
For Each objSubfolder In objFolder.Folders
Debug.Print objSubfolder.name
Debug.Print objSubfolder.Items.Count
Next objSubfolder
End Sub
In this late binding, I have used 6 in stead of olFolderInbox.
Edit:
If you want the results in the cells, use this code:
Option Explicit
Sub LoopFoldersInInbox()
Dim ns As Object
Dim objFolder As Object
Dim objSubfolder As Object
Dim lngCounter As Long
Set ns = GetObject("", "Outlook.Application").GetNamespace("MAPI")
Set objFolder = ns.GetDefaultFolder(6) ' 6 is equal to olFolderInbox
For Each objSubfolder In objFolder.Folders
With ActiveSheet
lngCounter = lngCounter + 1
.Cells(lngCounter, 1) = objSubfolder.Name
.Cells(lngCounter, 2) = objSubfolder.Items.Count
End With
Debug.Print objSubfolder.Name
Debug.Print objSubfolder.Items.Count
Next objSubfolder
End Sub
The below is more of what I am looking for but Vityana's code works very well too. It all depends on what you need. I would like to specify a folder within the "Inbox" but am currently unable to. This only gets the count for the "Inbox" but there are folders nested under the "Inbox" folder that I am unable to specify. Anyone know how to do that?
Sub HowManyEmails()
Dim objOutlook As Object, objnSpace As Object, objFolder As Object
Dim EmailCount As Integer
Set objOutlook = CreateObject("Outlook.Application")
Set objnSpace = objOutlook.GetNamespace("MAPI")
On Error Resume Next
Set objFolder = objnSpace.Folders("Joe.L.Smo#company.com").Folders("Inbox")
If Err.Number <> 0 Then
Err.Clear
MsgBox "No such folder."
Exit Sub
End If
EmailCount = objFolder.Items.Count
Set objFolder = Nothing
Set objnSpace = Nothing
Set objOutlook = Nothing
[B2].Value = EmailCount
End Sub
You can just "continue the specification".
You had:
Set objFolder = objnSpace.Folders("Joe.L.Smo#company.com").Folders("Inbox")
To get -for example- the content of the subfolder Temp under the Inbox, specify:
Set objFolder = objnSpace.Folders("Joe.L.Smo#company.com").Folders("Inbox").Folders("Temp")
Hope this helps

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