I am unable to download file from Outlook. Getting error "cannot save the attachment. You do not have appropriate permission". Given below line is throwing error.
ATMT.SaveAsFile "C:\Users\p2018\Desktop\mail folder"
Also sharing the code
Sub ExtracFiles()
Dim O As Outlook.Application
Set O = New Outlook.Application`
Dim ONS As Outlook.Namespace
Set ONS = O.GetNamespace("MAPI")
Dim Fol As Outlook.Folder
Set Fol = ONS.GetDefaultFolder(olFolderInbox).Folders("Weekly Compliance
Report")
Dim OMAIL As Outlook.MailItem
Set OMAIL = O.CreateItem(olMailItem)
Dim ATMT As Outlook.Attachment
Dim mydate As Date
mydate = Format(Date, "mm-dd-yyyy")
For Each OMAIL In Fol.Items
For Each ATMT In OMAIL.Attachments
If
OMAIL.SenderEmailAddress="PeopleGroup#Check.com" And _
Format(OMAIL.ReceivedTime, _
"mm-dd-yyyy") = mydate Then
ATMT.SaveAsFile "C:\Users\p2018\Desktop\mail folder"
MsgBox ATMT
Else
End If
Next ATMT
Next OMAIL
End Sub
You must specify the fully qualified filename, not just path:
ATMT.SaveAsFile "C:\Users\p2018\Desktop\mail folder\" & ATMT.FileName
Bringing this up again, but I've been encountering the very same error for the whole morning.
Turned out there was a file with the exact same name of the Outlook attachment, so it wouldn't let me overwrite it.
Saving the attachment with a different name works well.
Related
I have some VBA which sometimes fails on the line Set Folder = Inbox.Folders("xxx") with the below error message.
Folder = Inbox.Folders is returning 0 folders even though I can see them in the the Outlook pane.
Run-time error '-2147221233 (8004010f)'
The attempted operation failed. An object could not be found.
Sub Export()
Select_Date.Show
'Dim OutlookApp As Outlook.Application
'Dim OutlookNamespace As NameSpace
'Dim Folder As MAPIFolder
'Dim OutlookMail As Variant
'Dim i As Integer
'Dim olNS As Outlook.NameSpace
'Dim Start_Date As Date
'Dim saveFolder As String
Start_Date = DateValue(Select_Date.ComboBox1.Value & " " & Select_Date.ComboBox2.Value & " " & Select_Date.ComboBox3.Value)
overwrite_flag = Select_Date.CheckBox1.Value
saveFolder = "K:\xxxx "
Set OutlookApp = New Outlook.Application
Set OutlookNamespace = OutlookApp.GetNamespace("MAPI")
Set objowner = OutlookNamespace.CreateRecipient("xx.xxx#xxx.com")
objowner.Resolve
Set Inbox = OutlookNamespace.GetSharedDefaultFolder(objowner, olFolderInbox)
'Set Folder_test = Inbox.Folders.GetLast
Set Folder = Inbox.Folders("xxx")
'Set Folder = Session.Folders("xxx").Folders("Inbox")
i = 1
For Each OutlookMail In Folder.Items
If TypeOf OutlookMail Is MailItem Then
If OutlookMail.ReceivedTime >= Start_Date And OutlookMail.Subject = "xxxx" Then
For Each attach In OutlookMail.Attachments
savename = saveFolder & Format(DateAdd("d", 35, OutlookMail.ReceivedTime), "yyyymmdd") & ".csv"
If (Dir$(savename) <> "") Then
If overwrite_flag = True Then
Kill savename ' delete if file exists
attach.SaveAsFile savename
End If
Else: attach.SaveAsFile savename
End If
attach.SaveAsFile savename
Next attach
End If
End If
i = i + 1
Next OutlookMail
Set Folder = Nothing
Set OutlookNamespace = Nothing
Set OutlookApp = Nothing
End Sub
You may try to iterate over all subfolders and find the required one by checking its name.
Also I've noticed that your code iterates over all items in the folder which is not really a good idea! Use the Find/FindNext or Restrict methods of the Items class. Read more about these methods in the following articles:
How To: Use Find and FindNext methods to retrieve Outlook mail items from a folder (C#, VB.NET)
How To: Use Restrict method to retrieve Outlook mail items from a folder
The error is MAPI_E_NOT_FOUND, which means either the folder with that name does not exist, or that you have no access to its subfolders.
Also note that if shared folders are set to be cached, Outlook only caches the folder itself, but not its subfolders, hence you won't be able to access any subfolders.
Every time I receive an email with the subject "Test", I want to:
Automatically extract all attachments and store them in its own new created folder.
Automatically copy the email inside this new folder
Automatically add a Word document inside this new folder.
The folder must be named by the date received.
The code I have copies all attachments in a pre-selected folder, but it doesn't create a personal folder for them.
Private WithEvents Items As Outlook.Items
Private Sub Application_Startup()
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
End Sub
Private Sub Items_ItemAdd(ByVal item As Object)
On Error GoTo ErrorHandler
'Only act if it's a MailItem
Dim Msg As Outlook.MailItem
If TypeName(item) = "MailItem" Then
Set Msg = item
'Change variables to match need. Comment or delete any part unnecessary.
If (Msg.Subject = "Heures") And _
(Msg.Attachments.Count >= 1) Then
'Set folder to save in.
Dim olDestFldr As Outlook.MAPIFolder
Dim myAttachments As Outlook.Attachments
Dim Att As Variant
Const attPath As String = "C:\Users\NASC02\Test\"
' save attachment
Set myAttachments = item.Attachments
For Each Att In myAttachments
Att.SaveAsFile attPath & Att.FileName
Next
' mark as read
Msg.UnRead = False
End If
End If
ProgramExit:
Exit Sub
ErrorHandler:
MsgBox Err.Number & " - " & Err.Description
Resume ProgramExit
End Sub
The code
Set myAttachments = item.Attachments
Att = myAttachments.item(1).DisplayName
myAttachments.item(1).SaveAsFile attPath & Att
needs to be changed to
Set myAttachments = item.Attachments
for each Att in myAttachments
Att.SaveAsFile attPath & Att.FileName
next
I'm using the following code to automatically export PDF files in Outlook when they arrive in my inbox. However the file that it saves is corrupted. The SaveAsFile method only takes one argument - the file path to save to - it doesn't say in the documentation that I can pass a filetype. How do I save these PDF attachments without corrupting the files?
Private WithEvents Items As Outlook.Items
Private Sub Application_Startup()
'Declaring Variables [BD]
Dim oOutlook As Outlook.Application
Dim oNameSpace As Outlook.NameSpace
Dim oFolder As Outlook.MAPIFolder
'Intializing Variables [BD]
Set oOutlook = Outlook.Application
Set oNameSpace = Application.GetNamespace("MAPI")
Set oFolder = oNameSpace.GetDefaultFolder(olFolderInbox).Parent
Set oFolder = oFolder.Folders("Produce Availability").Folders("Earls Organic")
Set Items = oFolder.Items
End Sub
Private Sub Items_ItemAdd(ByVal Item As Object)
'Declaring Variables [BD]
Dim sOutputFileName As String
Dim oMessage As Outlook.MailItem
Dim oAttachment As Outlook.Attachments
'Initializing Variables [BD]
sDateTime = Format(Now(), "yyyymmddhhnnss")
sOutputFolderPath = "C:\Earls Organic\"
On Error GoTo ErrorHandler
If TypeName(Item) = "MailItem" Then
Set oMessage = Item
Set oAttachment = oMessage.Attachments
sOutputFileName = oMessage.Subject & " " & sDateTime
sOutputFolderPathAndName = sOutputFolderPath & sOutputFileName & ".pdf"
oAttachment.Item(1).SaveAsFile sOutputFolderPathAndName
Set oAttachment = Nothing
Set oItem = Nothing
End If
ProgramExit:
Exit Sub
ErrorHandler:
MsgBox Err.Number & " - " & Err.Description
Resume ProgramExit
End Sub
As requested, here is my comment as an answer:
Are you sure Attachment(1) is the PDF file? Signatures and images can be recorded as attachments. You should scan down the attachment collection checking the extension until you find the PDF file.
SaveAsFile does not corrupt files. You never check that the file is actually a PDF - you can have other attachments which may or may not be seen as such in Outlook (such as images). You assume that the very first attachment is a PDF. Loop through all attachments do check the Attachment.FileName property to make sure you get what you expect.
I am writing a program to track the current status of projects.
The users would like to save relevant documents to the current project. I can do this for files that are residing in a folder with FileSaveDialog. However, many times the file is an e-mail message or an attachment to a message. I would like to grab this directly from Outlook and either save the message as an MSG or save the attachment.
I have code like below to reference Outlook messages from VB.NET but I can't figure out how to reference an entire message to save as msg or attachment filename.
Dim objOutlook As Outlook._Application
objOutlook = New Outlook.Application()
Dim objSelection As Outlook.Selection = objOutlook.ActiveExplorer.Selection
Dim iCount As Int16 = objSelection.Count
For i = iCount To 1 Step -1
Console.WriteLine(objSelection.Item(i).Subject)
Console.WriteLine(objSelection.Item(i).Attachments)
Next
Use the Outlook Object Library for this.
An example on how to download an attachment from an unread mail:
Private Sub ThisAddIn_NewMail() Handles Application.NewMail
Dim inBox As Outlook.MAPIFolder = Me.Application.ActiveExplorer() _
.Session.GetDefaultFolder(Outlook. _
OlDefaultFolders.olFolderInbox)
Dim inBoxItems As Outlook.Items = inBox.Items
Dim newEmail As Outlook.MailItem
inBoxItems = inBoxItems.Restrict("[Unread] = true")
Try
For Each collectionItem As Object In inBoxItems
newEmail = TryCast(collectionItem, Outlook.MailItem)
If newEmail IsNot Nothing Then
If newEmail.Attachments.Count > 0 Then
For i As Integer = 1 To newEmail.Attachments.Count
Dim saveAttachment As Outlook.Attachment = _
newEmail.Attachments(i)
newEmail.Attachments(i).SaveAsFile _
("C:\TestFileSave\" & (newEmail _
.Attachments(i).FileName))
Next i
End If
End If
Next collectionItem
Catch ex As Exception
If Left(ex.Message, 11) = "Cannot save" Then
MsgBox("Create Folder C:\TestFileSave")
End If
End Try
End Sub
Good luck!
Source: msdn
Having the same problem as you on saving an e-mail message I ended up with the following solution:
Sub SaveEmail()
'Save e-mail from Outlook
Dim objOL As Outlook.Application
Dim objMsg As Outlook.MailItem 'Object
Dim objSelection As Outlook.Selection
Dim strFile As String
'Instantiate an Outlook Application object.
objOL = CreateObject("Outlook.Application")
'Get the collection of selected objects.
objSelection = objOL.ActiveExplorer.Selection
'Set the target folder
Dim FilePath1 as String
FilePath1 = "C:\tmp\"
'Save each selected e-mail to disk
For Each objMsg In objSelection
'Save attachment before deleting from item.
'Get the file name using "objMsg.Subject" and remove special characters.
strFile = Regex.Replace(objMsg.Subject, "[^a-zA-Z0-9_ -]", "-",_
RegexOptions.Compiled)
'Combine with the path to the Temp folder.
strFile = FilePath1 & strFile & ".msg"
'Save the attachment as a file.
objMsg.SaveAs(strFile, Outlook.OlSaveAsType.olMSG)
Next
End Sub
For a bit of input on the regex.replace function please see the following links:
https://www.regular-expressions.info/charclass.html
https://learn.microsoft.com/en-us/dotnet/api/system.text.regularexpressions.regex.replace?view=netframework-4.7.2#System_Text_RegularExpressions_Regex_Replace_System_String_System_String_System_String_
So, the goal is that when I receive an email from a customer, containing the desired attachment, save the attachment to a location of my choosing.
This is my new code, it compiles but doesn't output the file?
Thanks in advance.
Private WithEvents Items As Outlook.Items
Private Sub Application_Startup()
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
End Sub
Private Sub Application_NewMail()
Dim oInbox As MAPIFolder
Dim oItem As MailItem
Set oInbox = Application.Session.GetDefaultFolder(olFolderInbox)
Set oItem = oInbox.Items.GetLast
'Only act if it's a MailItem
Dim Msg As Outlook.MailItem
If TypeName(item) = "MailItem" Then
Set Msg = oItem
'Change variables to match need. Comment or delete any part unnecessary.
If (Msg.SenderName = "Name Of Person") And _
(Msg.Subject = "Subject to Find") 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
'location to save in. Can be root drive or mapped network drive.
Const attPath As String = "C:\"
' save attachment
Set myAttachments = item.Attachments
Att = myAttachments.item(1).DisplayName
myAttachments.item(1).SaveAsFile attPath & Att
' mark as read
Msg.UnRead = False
End If
End If
ProgramExit:
Exit Sub
ErrorHandler:
MsgBox Err.Number & " - " & Err.Description
Resume ProgramExit
End Sub
When you open the VBA window, you will see the object called "ThisOutlookSession", which is where you place the code.
This event is triggered automatically upon reception of a new email received:
Private Sub Application_NewMail()
Dim oInbox As MAPIFolder
Dim oItem As MailItem
Set oInbox = Application.Session.GetDefaultFolder(olFolderInbox)
Set oItem = oInbox.Items.GetLast
//MsgBox oItem.To
//Etcetera
End Sub
About your edit, I didn't really investigate why it didn't work, but you can use this, which I tested:
Dim atmt As Outlook.Attachment
Dim Att As String
Const attPath As String = "U:\"
For Each atmt In Msg.Attachments
Att = atmt.DisplayName
atmt.SaveAsFile attPath & Att
Next
Note that it may seem as if you didn't save the file, because you cannot use 'Date modified' in WinExplorer to show the latest saved attachment (I noticed just now). But you can look it up alphabetically.