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?
Related
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
I want a macro/rule/code that creates a folder in Outlook based on the sender's domain, after that I want it to create a folder based on the sender's name in the sender's domain folder, and then move the mail to that folder.
I am thinking of a folder layout like this:
Inbox\#senders domain\#Senders name\Email.msg
Please refer to this code, however, you may need to change something as your special request.
Private WithEvents Items As Outlook.Items
Private Sub Application_Startup()
Dim olApp As Outlook.Application
Dim objNS As Outlook.NameSpace
' set object reference to default Inbox
Set olApp = Outlook.Application
Set objNS = olApp.GetNamespace("MAPI")
Set Items = objNS.GetDefaultFolder(olFolderInbox).Items
End Sub
Private Sub Items_ItemAdd(ByVal item As Object)
' fires when new item added to default Inbox
' (per Application_Startup)
On Error GoTo ErrorHandler
Dim Msg As Outlook.MailItem
Dim olApp As Outlook.Application
Dim objNS As Outlook.NameSpace
Dim targetFolder As Outlook.MAPIFolder
Dim senderName As String
' don't do anything for non-Mailitems
If TypeName(item) <> "MailItem" Then GoTo ProgramExit
Set Msg = item
' move received email to target folder based on sender name
senderName = Msg.senderName
If CheckForFolder(senderName) = False Then ' Folder doesn't exist
Set targetFolder = CreateSubFolder(senderName)
Else
Set olApp = Outlook.Application
Set objNS = olApp.GetNamespace("MAPI")
Set targetFolder = _
objNS.GetDefaultFolder(olFolderInbox).Folders(senderName)
End If
Msg.Move targetFolder
ProgramExit:
Exit Sub
ErrorHandler:
MsgBox Err.Number & " - " & Err.Description
Resume ProgramExit
End Sub
Function CheckForFolder(strFolder As String) As Boolean
' looks for subfolder of specified folder, returns TRUE if folder exists.
Dim olApp As Outlook.Application
Dim olNS As Outlook.Namespace
Dim olInbox As Outlook.MAPIFolder
Dim FolderToCheck As Outlook.MAPIFolder
Set olApp = Outlook.Application
Set olNS = olApp.GetNamespace("MAPI")
Set olInbox = olNS.GetDefaultFolder(olFolderInbox)
' try to set an object reference to specified folder
On Error Resume Next
Set FolderToCheck = olInbox.Folders(strFolder)
On Error Goto 0
If Not FolderTocheck Is Nothing Then
CheckForFolder = True
End If
ExitProc:
Set FolderToCheck = Nothing
Set olInbox = Nothing
Set olNS = Nothing
Set olApp = Nothing
End Function
Function CreateSubFolder(strFolder As String) As Outlook.MAPIFolder
' assumes folder doesn't exist, so only call if calling sub knows that
' the folder doesn't exist; returns a folder object to calling sub
Dim olApp As Outlook.Application
Dim olNS As Outlook.Namespace
Dim olInbox As Outlook.MAPIFolder
Set olApp = Outlook.Application
Set olNS = olApp.GetNamespace("MAPI")
Set olInbox = olNS.GetDefaultFolder(olFolderInbox)
Set CreateSubFolder = olInbox.Folders.Add(strFolder)
ExitProc:
Set olInbox = Nothing
Set olNS = Nothing
Set olApp = Nothing
End Function
More information, please see,
Create new folder for new sender name and move message into new folder
I am trying to move tasks from the To-Do list to an "Inquiries" Task folder.
Preferably it should move the task without having to select it.
This code gives me:
'Runtime Error '424' Object Required'
Original code from https://www.slipstick.com/outlook/macro-move-folder/
Sub MoveTask()
Dim objOutlook As Outlook.Application
Dim objNamespace As Outlook.NameSpace
Dim objSourceFolder As Outlook.MAPIFolder
Dim objDestFolder As Outlook.MAPIFolder
Dim objItem As TaskItem
Dim strSignifier As String
Set objOutlook = Application
Set objNamespace = objOutlook.GetNamespace("MAPI")
Set objSourceFolder = objNamespace.GetDefaultFolder(olFolderTasks)
Set objItem = objFolder.Items.Add(olTaskItem) ' this line has the error
Set objDestFolder = objNamespace.GetDefaultFolder(olFolderTasks).Folders("Inquiries")
strSignifier = "#CT-"
If Left(Item.subject, Len(strSignifier)) = strSignifier Then
objItem.Move objDestFolder
End If
Set objDestFolder = Nothing
End Sub
You need to also Dim and Set objFolder in order to use it, or change it to objDestFolder or objSourceFolder depending on what you are trying to do.
Put Option Explicit at the top of your module and it will help detect these things.
I hope there is someone who have an idea about this issue.
I want to archive a sender's emails(for example send form : test#tect.com) to more than one folder in outlook concurrently by using automatic rule function.
Is this possible?
Yes it is possible with help of script rule and vba code.
the following code creates a copy of the identified message as it arrives and then moves the copy message to multiple to folders.
Option Explicit
Public Sub MoveItems(olItem As Outlook.MailItem)
Dim olApp As New Outlook.Application
Dim olNameSpace As Outlook.NameSpace
Dim olInbox As Outlook.MAPIFolder
Dim olDestFolder As Outlook.MAPIFolder
Dim olItems As Outlook.Items
Dim CopyItem As Object
Set olNameSpace = olApp.GetNamespace("MAPI")
Set olInbox = olNameSpace.GetDefaultFolder(olFolderInbox)
Set olItems = olInbox.Items
'// loop
While TypeName(olItem) <> "Nothing"
Set olDestFolder = olInbox.Folders("TEMP1") 'Folder
Set CopyItem = olItem.copy
olItem.Move olDestFolder
Set olDestFolder = olInbox.Folders("TEMP2") 'Folder
olItem.Move olDestFolder
Set olDestFolder = olInbox.Folders("TEMP3") 'Folder
olItem.Move olDestFolder
'// Add more folders here
Set olItem = olItems.FindNext
Wend
Set olNameSpace = Nothing
Set olInbox = Nothing
Set olDestFolder = Nothing
Set olItems = Nothing
Set olItem = Nothing
Set CopyItem = Nothing
End Sub
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