To find all emails (by folder name i.e. email id) from subfolders of inbox present since last month and copy paste them in respective folders by their subject.
I am stuck at code NS = OlApp.GetNamespace("MAPIFolder") also with ("MAPI") as well the error of object variable not set is displaying
Dim OlApp As Outlook.Application
Set OlApp = New Outlook.Application
Set OlApp = CreateObject("Outlook.Application")
Dim fldrpath As String
Dim fldername As String
Dim oMail As Object
fldrpath = "\data\EMAILS\" & fldrname
Dim NS As Namespace
Dim Folder As MAPIFolder
Dim sName As String
Dim dtdate As String
Dim Inbox As MAPIFolder
NS = OlApp.GetNamespace("MAPIFolder")
Set Inbox = NS.GetDefaultFolder(olFolderInbox)
For Each mysubFolders In Inbox.subFolders
Set mysubfolder = Inbox.subFolders("PDI").Folders("OBU").Folders("DND")
For Each mailItems In mysubfolder
If oMail.Body = r Then
Set mailItems = oMail
sName = mailItems.Subject
dtdate = mailItems.ReceivedTime
Debug.Print fldrpath & sName
mailItems.SaveAs fldrpath & sName, olMSG
End If
Next
Set OlApp = Nothing
Set mailItems = Nothing
Next
End Sub
The first problem is this line, missing the Set keyword:
Set NS = OlApp.GetNamespace("MAPIFolder")
Then you are accessing "Inbox.subFolders", but there is no such property on a Folder object; it would be the Folders property collection that you want.
You also aren't using the mysubFolders variable in the loop, so that entire block of code is going to fail. There is also no explicit set of the mailItems object you are trying to iterate from the mysubfolder object.
I'd continue but frankly the entire method needs to be rewritten. Focus on ensuring you are declaring and setting the correct variables to the correct properties or objects.
Related
This code saves the attachment from Outlook to a specific folder in my PC.
I need to move the selected mail in Outlook inbox to a folder in Outlook.
Ultimately, I will save the attachment and move this mail to a folder in Outlook.
Sub INC_Data()
Dim ol As Object 'Outlook.Application
Dim ns As Object 'Outlook.Namespace
Dim fol As Object 'Outlook.Folder
Dim i As Object
Dim mi As Object 'Outlook.MailItem
Dim at As Object 'Outlook.Attachment
Dim fso As Object 'Scripting.FileSystemObject
Dim dir As Object 'Scripting.Folder
Dim dirName As String
Dim oFSO As Object
Dim oFolder As Object
Dim oFile As Object
Dim f As Integer
'Some Set Ups
Set fso = CreateObject(Class:="Scripting.FileSystemObject")
Set ol = CreateObject(Class:="Outlook.Application")
Set ns = ol.GetNamespace("MAPI")
Set fol = ns.GetDefaultFolder(olFolderInbox)
'Finding the search item from Oulook Inbox
For Each i In fol.Items
If i.Class = 43 Then
Set mi = i
If mi.Attachments.Count > 0 And InStr(mi.SenderEmailAddress, "xxxxxxx#inc.ae") Then
dirName = "D:\XYZ "
If fso.FolderExists(dirName) Then
Set dir = fso.GetFolder(dirName)
Else
Set dir = fso.Createfolder(dirName)
End If
'Saving Attachment to a folder
For Each at In mi.Attachments
If Right(at.Filename, 4) = "xlsm" Then
at.SaveAsFile dir.Path & "\" & Range("Ad2").Text & ".xlsm"
End If
Next at
End If
End If
Next i
End Sub
First, delcare an object variable so that we can assign it the destination folder...
Dim olMoveToFolder As Object 'Outlook.Folder
Then, assign the destination folder to the variable. So, for example, depending on your folder structure, something like this...
Set olMoveToFolder = ns.Folders("Outlook").Folders("DestinationFolderName")
or
Set olMoveToFolder = fol.Folders("DestinationFolderName")
Then, add the following line, after saving the attachments, to move your email to the destination folder...
mi.Move olMoveToFolder
EDIT
While I haven't tested it, I have amended your macro to include the following...
The statement Option Explicit has been added to force the explicit
declaration of variables to help catch any potential errors. Note that
this statement must be place at the very top of the
module, before any procedure.
Some of the variable names have been renamed in the interest of
clarity.
The variable dir has been removed since it's not really needed,
and since it can be confused with the function Dir().
The variable dirName is set prior to looping through your mail
items.
The constant olFolderInbox has been replaced with the value 6,
since you are using late binding.
Here's your macro, amended accordingly...
Option Explicit
Sub INC_Data()
Dim ol As Object 'Outlook.Application
Dim ns As Object 'Outlook.Namespace
Dim inboxFol As Object 'Outlook.Folder
Dim moveToFolder As Object 'Outlook.Folder
Dim itm As Object
Dim mi As Object 'Outlook.MailItem
Dim att As Object 'Outlook.Attachment
Dim fso As Object 'Scripting.FileSystemObject
Dim dirName As String
'Some Set Ups
Set fso = CreateObject(Class:="Scripting.FileSystemObject")
Set ol = CreateObject(Class:="Outlook.Application")
Set ns = ol.GetNamespace("MAPI")
Set inboxFol = ns.GetDefaultFolder(6) 'olFolderInbox
Set moveToFolder = ns.Folders("MainFolderName").Folders("MoveToFolderName") 'change the folder names accordingly
dirName = "D:\XYZ"
If Not fso.FolderExists(dirName) Then
fso.CreateFolder dirName
End If
'Finding the search item from Oulook Inbox
For Each itm In inboxFol.Items
If itm.Class = 43 Then
Set mi = itm
If mi.Attachments.Count > 0 And InStr(mi.SenderEmailAddress, "xxxxxxx#inc.ae") Then
'Saving Attachments to a folder
For Each att In mi.Attachments
If Right(att.Filename, 4) = "xlsm" Then
att.SaveAsFile dirName & "\" & Range("Ad2").Text & ".xlsm"
End If
Next att
'Move mail item to destination folder
mi.Move moveToFolder
End If
End If
Next itm
End Sub
I'm trying to save Outlook emails into my H:Drive. I want it as a run a script rule but I can't get it to work. There are no attachments involved and all I need it is to save it as a .msg file. Please lmk if you find a different way to tackle this problem.
Thanks
Sub ExtractEmailToFolder2(itm As Outlook.MailItem)
Dim OlApp As Outlook.Application
Set OlApp = New Outlook.Application
Dim Mailobject As Object
Dim Email As String
Dim NS As NameSpace
Dim Folder As MAPIFolder
Set OlApp = CreateObject("Outlook.Application")
Dim fso As Object
Dim fldrname As String
Dim fldrpath As String
' Setup Namespace
Set NS = ThisOutlookSession.Session
' Display select folder dialog
Set Folder = NS.PickFolder
' Create Folder File
Set fso = CreateObject("Scripting.FileSystemObject")
' loop to read email address from mail items.
For Each Mailobject In Folder.Items
fldrpath = "H:\Backup stuff\"
If Not fso.folderexists(fldrpath) Then
fso.createfolder (fldrpath)
End If
Set objCopy = Mailobject.Copy
objCopy.SaveAs fldrpath & "\" & objCopy.Subject, olMSG
Next
Set OlApp = Nothing
Set Mailobject = Nothing
End Sub
First of all, there is no need to create a new Outlook Application instance (twice in your sample code!) if your VBA macro is run by the rule. Instead, you can use the global Application property:
Sub ExtractEmailToFolder2(itm As Outlook.MailItem)
Dim fso As Object
Dim fldrname As String
Dim fldrpath As String
' Create Folder if required
Set fso = CreateObject("Scripting.FileSystemObject")
fldrpath = "H:\Backup stuff\"
If Not fso.folderexists(fldrpath) Then
fso.createfolder (fldrpath)
End If
itm.SaveAs fldrpath & "\" & "your_unique_filename.msg", olMSG
Set OlApp = Nothing
Set Mailobject = Nothing
End Sub
The sample code which is shown above saves the item against which the rule is run to the folder specified/hardcoded.
Problem:
Folder Check was included in the Loop
FileName had Subject in it. That always creates problem unless some kind of manipulation is done. Because it contains various characters that are not permitted in the Name of a File in Windows.
Note:
Put it in any Module in Outlook and Run using F5 or by Creating a Shortcut.
Try:
Sub ExtractEmailToFolder2()
Dim OlApp As Outlook.Application
Set OlApp = New Outlook.Application
Dim Mailobject As Object
Dim Email As String
Dim NS As NameSpace
Dim Folder As MAPIFolder
Set OlApp = CreateObject("Outlook.Application")
Dim fso As Object
Dim fldrname As String
Dim fldrpath As String
' Setup Namespace
Set NS = ThisOutlookSession.Session
' Display select folder dialog
Set Folder = NS.PickFolder
' Create Folder File
Set fso = CreateObject("Scripting.FileSystemObject")
fldrpath = "H:\Backup stuff\"
If Not fso.folderexists(fldrpath) Then
fso.createfolder (fldrpath)
End If
' loop to read email address from mail items.
i = 1
For Each Mailobject In Folder.Items
Mailobject.SaveAs fldrpath & "\mail" & i & ".msg", olMsg
i = i + 1
Next
Set OlApp = Nothing
Set Mailobject = Nothing
End Sub
Summary
I'm trying to add hyperlinks to tasks created from emails that I have moved to another folder.
The goal is to have the task contain a hyperlink to the Outlook item that was moved to a "Processed Email" folder".
Problem
I don't understand how to move a MailItem and then get its new EntryID after it moves.
The "naive" way doesn't work. After using the Move method to move a MailItem object, the EntryID property does not reflect a change in ID.
Details
Creating a hyperlink to an Outlook item using the format outlook:<EntryID> is easy enough if the Outlook item remains in the Inbox, since I can just get the EntryID of the object that I am linking to. However, Outlook changes the EntryID when an object is moved.
I want to understand how to get the updated ID so that I can construct an accurate link.
Example
The message boxes show the EntryID property of objMail returns the same value despite the fact that the object has moved. However, running a separate macro on the mail in the destination folder confirms that the EntryID has changed with the move.
Sub MoveObject(objItem As Object)
Select Case objItem.Class
Case olMail
Dim objMail As MailItem
Set objMail = objItem
MsgBox (objMail.EntryID)
Dim inBox As Outlook.MAPIFolder
Set inBox = Application.ActiveExplorer().Session.GetDefaultFolder(Outlook.OlDefaultFolders.olFolderInbox)
Dim destFolder As Outlook.MAPIFolder
Set destFolder = inBox.Folders("Processed Email")
If (Application.ActiveExplorer().CurrentFolder.Name <> destFolder.Name) Then
objMail.Move destFolder
End If
MsgBox (objMail.EntryID)
End Select
End Sub
The Move method of the MailItem class returns an object that represents the item which has been moved to the designated folder. You need to check out the EntryID value of the returned object, not the source one.
Anyway, you may consider handling the ItemAdd event of the target folder to make sure that an updated entry ID value is used all the time.
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
Set myNameSpace = Application.GetNamespace("MAPI")
Set myInbox = myNameSpace.GetDefaultFolder(olFolderInbox)
Set myItems = myInbox.Items
Set myDestFolder = myInbox.Folders("Personal Mail")
Set myItem = myItems.Find("[SenderName] = 'Eugene Astafiev'")
While TypeName(myItem) <> "Nothing"
myItem.Move myDestFolder
Set myItem = myItems.FindNext
Wend
End Sub
Hello can you please elaborate your answer I am not able to understand it.
Anyway, you may consider handling the ItemAdd event of the target folder to make sure that an updated entry ID value is used all the time.
Here is my code and I need EntryID after moving.
Sub Movetest1()
Dim olApp As Outlook.Application
Dim olns As Outlook.NameSpace
Dim Fld As Folder
Dim ofSubO As Outlook.MAPIFolder
Dim myDestFolder As Outlook.Folder
Dim ofolders As Outlook.Folders
Dim objItems As Outlook.Items
Dim myRestrictItems As Outlook.Items
Dim i As Long
Dim myitem As Object
' Dim MailItem As Microsoft.Office.Interop.Outlook.MailItem
Dim MailItem, moveditem As Outlook.MailItem
Dim eid As String
Dim sid As Variant
Dim newEID As String
'---------------------------------------------------------------------------------------------------------
Set olApp = New Outlook.Application
Set olns = olApp.GetNamespace("MAPI")
For Each Fld In olns.Folders
If Fld.Name = "GSS Payables" Then
'
' MsgBox Fld.Name
' Debug.Print " - "; Fld.EntryID
Set Fld = olns.GetFolderFromID("000000009DA6D76FBE7A58489450CDF6094F592A0100A2457DC435B22448A832DB721D8185B1000000B6207D0000").Folders("Inbox")
Exit For
End If
Next
Set objItems = Fld.Items
eid = "000000009DA6D76FBE7A58489450CDF6094F592A0700A2457DC435B22448A832DB721D8185B1000000B620800000A2457DC435B22448A832DB721D8185B100007FF773270000"
sid = "000000009DA6D76FBE7A58489450CDF6094F592A0100A2457DC435B22448A832DB721D8185B1000000B6207D0000"
Set myDestFolder = Fld.Folders("Bhagyashri")
'Set myitem = objItems.Find("[SenderName]='Microsoft Outlook '")
Set MailItem = olns.GetItemFromID(eid)
Set moveditem = MailItem.Move(myDestFolder)
"giving error here
newID = moveditem.entryid
Debug.Print "newID -"; newID
' get mailitem.parent.storeid
MsgBox "done"
End
Use the following syntax:
Dim MoveToFolder As outlook.MAPIFolder
Dim MyItem As outlook.MailItem
Dim NewEntryID As String
NewEntryID = MyItem.Move(MoveToFolder).ENTRYID
After MyItem.Move is executed the new ENTRYID will be returned to the NewEntryID variable.
I am trying to look through all Outlook folders for mail items matching certain parameters to save the attachment, from Excel.
I don't know how to reference scope to go through all folders, even custom folders.
I can't find the resources that answer my question.
Sub testing()
Dim myOlApp As New Outlook.Application
Dim scope As String
Dim filter As String
Dim rsts As Results
Dim AdvancedSearch As Outlook.Search
blnSearchComp = False
'I want it to search the entire mail account including normal folders like inbox and sent as well as custom folders.
'but this doesn't work. Any ideas?
scope = "'Fakeexample123#outlook.com'"
'filter assignment statement has been excluded
Set AdvancedSearch = myOlApp.AdvancedSearch(scope, filter, True, "test")
While blnSearchComp <> True
If AdvancedSearch.Results.Count > 0 Then
blnSearchComp = True
End If
Wend
Set rsts = AdvancedSearch.Results
For x = rsts.Count To 1 Step -1
rsts.Attachment.Item(x).SaveAsFile Project
Next
End Sub
Scope should be
'\\Fakeexample123#outlook.com'
Sub Demo_scopeformat()
Dim myOlApp As New outlook.Application
Dim scope As String
' Mailbox
scope = "'" & myOlApp.Session.GetDefaultFolder(olFolderInbox).Parent.folderPath & "'"
' Expected format
Debug.Print scope
End Sub
Well, I know it isn't the best solution, but I have come up with the following code to make a list of all of the parent folders, so that a for loop can be used with advanced search method to iterate the list. This will not be the fastest possible code, but should not be too slow.
Sub main()
'establishes connections
Dim myOlApp As New Outlook.Application
Dim objNS As Outlook.Namespace
Dim myFolder As Outlook.MAPIFolder
Set objNS = myOlApp.GetNamespace("MAPI")
'pick highest folder level as original my folder
Set myFolder = objNS.Folders("faxe.example123#outlook.com")
Call ProcessFolders(myFolder)
End Sub
Sub ProcessFolders(myFolder)
're establish connections
Dim myOlApp As New Outlook.Application
Dim objNS As Outlook.Namespace
Dim objFolder As Outlook.MAPIFolder
Set objNS = myOlApp.GetNamespace("MAPI")
'set up collection
Set x = New Collection
For Each objFolder In myFolder.Folders
'add all parent folder names to collection
'advanced search method will handle subfolders
'can use a recursive call here also to get subfolders though
x.Add objFolder.Name
Next
Set objNS = Nothing
Set myFolder = Nothing
Set myOlApp = Nothing
End Sub
I try to write some VBA to save the attachment files from some email to a folder
But I get the error
Run Time Error '424'
Object Required
This is the code I am trying to use
Sub test_extraer()
Dim olApp As Outlook.Application
Dim objNS As Outlook.NameSpace
Set olApp = Outlook.Application
Set objNS = olApp.GetNamespace("MAPI")
Set Items = objNS.GetDefaultFolder(olFolderInbox).Items
If (Msg.SenderName = "sender#email.com") And _
(Msg.Subject = "subject of the email") And _
(Msg.Attachments.Count >= 1) Then
'Set folder to save in.
Dim olDestFldr As Outlook.MAPIFolder
Dim myAttachments As Outlook.Attachments
Dim Att As String
Const attPath As String = "C:\temp\"
Set myAttachments = item.Attachments
Att = myAttachments.item(1).DisplayName
myAttachments.item(1).SaveAsFile attPath & Att
End If
End Sub
The error is triggered when the script enter to this if
If (Msg.SenderName = "sender#email.com") And _
(Msg.Subject = "subject of the email") And _
(Msg.Attachments.Count >= 1) Then
Any advice
Thanks in advance
Ok... where to start.
You definitely have some basic issues you need to work out here. You have a couple of variables that are not declared. The first of which is the cause of your title. msg in context is most likely supposed to be an Outlook.MailItem. Just declaring that variable is not the sole source of your problems. Next you have item which much like msg in context should be an Outlook.MailItem. You are missing a loop that would navigate through all the items in the Inbox as well.
So you are just trying to navigate the Inbox looking for a particular item correct? Just adding the loop would create another issue. Some of the items in the inbox are not mail items. To address this we navigate every object in the inbox and examine every mailitem we come across. If that matches the criteria of sender,subject and number of items we proceed to .SaveAsFile to the destination directory.
Sub Test_ExtraER()
Const strAttachmentPath As String = "C:\temp\"
Dim olApp As Outlook.Application
Dim objNS As Outlook.NameSpace
Dim objFolder As Outlook.MAPIFolder
Dim objItem As Object
Dim strFileName As String
Set olApp = Outlook.Application
Set objNS = olApp.GetNamespace("MAPI")
Set objFolder = objNS.GetDefaultFolder(olFolderInbox)
For Each objItem In objFolder.Items
If TypeName(objItem) = "MailItem" Then
If (objItem.Attachments.Count >= 1) And (objItem.Subject = "Some Subject") And (objItem.SenderName = "sender#email.com") Then
With objItem.Attachments.Item(1)
strFileName = strAttachmentPath & .DisplayName
Debug.Print strFileName
.SaveAsFile strFileName
End With
End If
End If
Next
End Sub
This is mostly preference but, as you can see, I made some other coding changes. I renamed some of the other variables to be a little more descriptive of the object it was. Also moved all the Dims and Const together for better readability.
One last thing. It would seem you are navigating you entire inbox looking for a small subset of mails. You could create a rule that would process these mails as they come into your mailbox. An example of this would be: Save Outlook attachment to disk
Sub test_extraer()
Dim olApp As Outlook.Application
Dim objNS As Outlook.NameSpace
Dim MailItems As Outlook.MAPIFolder 'Add this one
Dim Msg As Outlook.MailItem 'Add this one
Set olApp = Outlook.Application
Set objNS = olApp.GetNamespace("MAPI")
Set MailItems = objNS.GetDefaultFolder(olFolderInbox)
For Each Msg In MailItems.Items 'loop thru the inbox folder to match the exact sender name and subject
If (Msg.SenderName = "Sender Name Here") And _
(Msg.Subject = "Subject Here") And _
(Msg.Attachments.Count >= 1) Then
'Set folder to save in.
Dim olDestFldr As Outlook.MAPIFolder
Dim myAttachments As Outlook.Attachments
Dim Att As String
Const attPath As String = "C:\temp\"
Set myAttachments = Msg.Attachments
Att = myAttachments.Item(1).DisplayName
myAttachments.Item(1).SaveAsFile attPath & Att
End If
Next
End Sub