I wanted to save an attached excel file in outlook to a ftp space with VBA.
I have mapped ftp folder in Windows 10 and I can reach it.
But macro cannot save attachment in that folder. The code is
Public Sub CheckEmail_BlueRecruit()
Dim outlookApp As Outlook.Application
Dim outlookNamespace As Outlook.NameSpace
Dim outlookFolder As Outlook.MAPIFolder
Dim filterKeywords As String
Dim filter As String
Set outlookApp = New Outlook.Application
Set outlookNamespace = Outlook.GetNamespace("MAPI")
Set outlookFolder = outlookNamespace.GetDefaultFolder(olFolderInbox)
filterKeywords = "I: Reservations"
filter = "#SQL=" & Chr(34) & "urn:schemas:httpmail:subject" & Chr(34) & " LIKE '%" & filterKeywords & " %'"
LoopFolders outlookFolder, filter
End Sub
Private Sub LoopFolders(ByVal outlookFolder As Outlook.MAPIFolder, ByVal filter As String)
Dim outlookSubFolder As Outlook.MAPIFolder
Dim outlookMail As Outlook.MailItem
ProcessFolder outlookFolder, filter
If outlookFolder.Folders.Count > 0 Then
For Each outlookSubFolder In outlookFolder.Folders
LoopFolders outlookSubFolder, filter
Next
End If
End Sub
Private Sub ProcessFolder(ByVal outlookFolder As Outlook.MAPIFolder, ByVal filter As String)
Dim outlookItems As Outlook.Items
Dim outlookMail As Outlook.MailItem
Set outlookItems = outlookFolder.Items.Restrict(filter)
If Not outlookItems Is Nothing Then
For Each outlookMail In outlookItems
If outlookMail.Attachments.Count <> 0 Then
For i = outlookMail.Attachments.Count To 1 Step -1
'Debug.Print outlookMail.Subject
strFile = outlookMail.Attachments.Item(i).FileName
Debug.Print strFile
strFolderpath = "ftp://myserverexample.it/public_html/check/import/drive/"
outlookMail.Attachments.Item(i).SaveAsFile strFolderpath & strFile
Next i
End If
Next outlookMail
End If
End Sub
Manually I can navigate the FTP folder as a normal Window folder, but macro cannot save in that position, Why?
Thx a lot
The Attachment.SaveAsFile method takes a string as a parameter which stands for the location at which to save the attachment. The string should be represented by a local file path. After saving the file on the hard drive locally you can upload it to any ftp server programmatically.
Related
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'm trying to save attachments from multiple subfolders.
My code is not iterating through subfolders, it's only saving one attachment.
Private WithEvents Items As Outlook.Items
Private Count As Integer
Private Sub Application_Startup()
Dim objApp As Outlook.Application
Dim objNameSpace As Outlook.NameSpace
Dim path_location As String
' Get the items in the Inbox folder
Set objApp = Outlook.Application
Set objNameSpace = objApp.GetNamespace("MAPI")
Set Items = objNameSpace.Folders("Archives_May_2016").Folders("Inbox").Folders("subfolder1").Items
path_location = "C: \emails" & "\Attachments\"
For Each Item In Items
Items.Item(1).Attachments.Count
' Initialize count
strFile = Items.Item(1).Attachments.Item(1).FileName
strFile = path_location & strFile
Items.Item(1).Attachments.Item(1).SaveAsFile strFile
Count = Count + 1
Next
End Sub
You are always accessing the same file since you are setting Items before the for loop, but inside it you are doing:
Items.Item(1).Attachments.Count
Try changing the for loop to:
For Each Item In Items
atts = Item.Attachments.Count
For i = 1 to atts
strFile = Item.Attachments.Item(i).FileName
strFile = path_location & strFile
Item.Attachments.Item(i).SaveAsFile strFile
Next
Next
I am trying to run this to macro to move an email attachment from a folder in my inbox (called toolkit downloads) into a folder on my desktop and rename the attachment.
I get
Run-time error '438': Object doesn't support this property or method
Sub OSP()
Dim oOutlook As Outlook.Application
Dim oNs As Outlook.NameSpace 'Main Outlook Today
Dim oFldrSb As Outlook.MAPIFolder 'Sub Folder in Outlook Today
Dim oFldrSbSb As Outlook.MAPIFolder 'Sub in Sub Folder
Dim oFldrSbSbsb As Outlook.MAPIFolder 'Sub in Sub in Sub Folder
Dim oMessage As Object
Dim sPathName As String
Dim oAttachment As Outlook.Attachment
Dim Ictr As Integer
Dim iAttachCnt As Integer
sPathName = "H:\Desktop\Toolkit Downloads\" 'My Folder Path where to save attachments
Set oOutlook = New Outlook.Application
Set oNs = oOutlook.GetNamespace("MAPI")
Set oFldrSb = oNs.Folders("Joe.Bloggs#test.co.uk")
Set oFldrSbSb = oFldrSb.Folders("Inbox")
Set oFldrSbSbsb = oFldrSbSb.Folders("Toolkit Downloads")
For Each oMessage In oFldrSbSbsb.Items
With oMessage.Attachments
iAttachCnt = .Count
If iAttachCnt > 0 Then
For Ictr = 1 To iAttachCnt
.Item(Ictr).SaveAsFile sPathName _
& .Item(Ictr).Parent
Next Ictr
End If
End With
DoEvents
Next oMessage
SaveAttachments = True
MsgBox "All Indepol Download files have been moved !!" & vbCrLf & vbCrLf & "It worked... Yahoo"
End Sub
You are trying to use the MailItem object as a string in the method SaveAsFile, ergo the error.
I'm guessing that you want to include the mail's subject into the new file name :
.Item(Ictr).SaveAsFile sPathName _
& .Item(Ictr).Parent.Subject
And if you have multiples attachments, I'd add the initial file name in there :
.Item(Ictr).SaveAsFile sPathName _
& .Item(Ictr).Parent.Subject
& .Item(Ictr).FileName
Full code :
Sub OSP()
Dim oOutlook As Outlook.Application
Dim oNs As Outlook.NameSpace 'Main Outlook Today
Dim oFldrSb As Outlook.MAPIFolder 'Sub Folder in Outlook Today
Dim oFldrSbSb As Outlook.MAPIFolder 'Sub in Sub Folder
Dim oFldrSbSbsb As Outlook.MAPIFolder 'Sub in Sub in Sub Folder
Dim oMessage As Object
Dim sPathName As String
Dim oAttachment As Outlook.Attachment
Dim Ictr As Integer
Dim iAttachCnt As Integer
sPathName = "H:\Desktop\Toolkit Downloads\" 'My Folder Path where to save attachments
Set oOutlook = Application
Set oNs = oOutlook.GetNamespace("MAPI")
Set oFldrSb = oNs.Folders("Joe.Bloggs#test.co.uk")
Set oFldrSbSb = oFldrSb.Folders("Inbox")
Set oFldrSbSbsb = oFldrSbSb.Folders("Toolkit Downloads")
For Each oMessage In oFldrSbSbsb.items
With oMessage.Attachments
iAttachCnt = .Count
If iAttachCnt > 0 Then
For Ictr = 1 To iAttachCnt
.Item(Ictr).SaveAsFile sPathName _
& .Item(Ictr).Parent.Subject
& .Item(Ictr).FileName
Next Ictr
End If
End With
DoEvents
Next oMessage
SaveAttachments = True
MsgBox "All Indepol Download files have been moved !!" & vbCrLf & vbCrLf & "It worked... Yahoo"
End Sub
First of all, there is no need to create a new Outlook Application instance if you run the VBA macro in Outlook:
Set oOutlook = New Outlook.Application
Instead, use the Application property available in the defualt module.
The SaveAsFile method of the Attachment class accepts a string which stands for the location at which to save the attachment. Make sure a string is passed there.
In general, I'd suggest debugging the code line by line and find which property or method exactly generates an error. You may find the Getting Started with VBA in Outlook 2010 article helpful.
I am not familiar with vba enough to modify this for my needs.
I need to download the attachments from a specific folder.
I found this example, but I am not sure how to get the folder where these emails are sent to.
I have a rule that when these emails come in, it places them into a different folder.
This where I want to run the macro so it only strips the attachments from these emails and places them on the local computer folder.
What parts do I need to change to get this to work for my needs?
Public Sub SaveAttachments(Item As Outlook.MailItem)
If Item.Attachments.Count > 0 Then
Dim objAttachments As Outlook.Attachments
Dim lngCount As Long
Dim strFile As String
Dim sFileType As String
Dim i As Long
Set objAttachments = Item.Attachments
lngCount = objAttachments.Count
For i = lngCount To 1 Step -1
' Get the file name.
strFile = objAttachments.Item(i).FileName
' Get the path to your My Documents folder
strfolderpath = CreateObject("WScript.Shell").SpecialFolders(16)
strfolderpath = strfolderpath & "\Attachments\"
' Combine with the path to the folder.
strFile = strfolderpath & strFile
' Save the attachment as a file.
objAttachments.Item(i).SaveAsFile strFile
Next i
End If
End Sub
To open a folder on the same level as your Inbox, open Inbox, then go one level up to its parent, then retrieve your folder by name:
set MyFolder = Application.Session.GetDefaultFolder(olFolderInbox).Parent.Folders.Item("My Folder Name")
Code goes under ThisOutlookSession Update folder Name "Temp"
Private WithEvents Items As Outlook.Items
Private Sub Application_Startup()
Dim olNameSpace As Outlook.NameSpace
Dim olFolder As Outlook.MAPIFolder
Set olNameSpace = Application.GetNamespace("MAPI")
Set olFolder = olNameSpace.GetDefaultFolder(olFolderInbox).Folders("TEMP")
Set Items = olFolder.Items
End Sub
Private Sub Items_ItemAdd(ByVal Item As Object)
If TypeOf Item Is Outlook.MailItem Then
SaveAttachments Item
End If
End Sub
'// http://www.slipstick.com/developer/save-attachments-to-the-hard-drive/
Public Sub SaveAttachments(Item As Outlook.MailItem)
If Item.Attachments.Count > 0 Then
Dim objAttachments As Outlook.Attachments
Dim lngCount As Long
Dim strFile As String
Dim sFileType As String
Dim i As Long
Set objAttachments = Item.Attachments
lngCount = objAttachments.Count
For i = lngCount To 1 Step -1
' Get the file name.
strFile = objAttachments.Item(i).FileName
' Get the path to your My Documents folder
strFolderpath = CreateObject("WScript.Shell").SpecialFolders(16)
strFolderpath = strFolderpath & "\Attachments\"
' Combine with the path to the folder.
strFile = strFolderpath & strFile
' Save the attachment as a file.
objAttachments.Item(i).SaveAsFile strFile
Next i
End If
End Sub
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_