Solved

Macro to copy file attachment from incoming email and save to location on c: drive

Posted on 2013-01-09
9
483 Views
Last Modified: 2013-01-09
Hi Experts

How would you create a macro that copies an excel file attachment from an incoming email that's going to a central mail box and save a copy of the file to a location on the c: drive..
0
Comment
Question by:route217
[X]
Welcome to Experts Exchange

Add your voice to the tech community where 5M+ people just like you are talking about what matters.

  • Help others & share knowledge
  • Earn cash & points
  • Learn & ask questions
  • 6
  • 3
9 Comments
 
LVL 31

Expert Comment

by:gowflow
ID: 38758476
what is the name of the folder the email reside on ?
gowflow
0
 

Author Comment

by:route217
ID: 38758942
CM Template
0
 

Author Comment

by:route217
ID: 38759459
Here is a file I have found which might do the job..

Public Sub SaveAttachments()
Dim objOL As Outlook.Application
Dim objMsg As Outlook.MailItem 'Object
Dim objAttachments As Outlook.Attachments
Dim objSelection As Outlook.Selection
Dim i As Long
Dim lngCount As Long
Dim strFile As String
Dim strFolderpath As String
Dim strDeletedFiles As String
 
    ' Get the path to your My Documents folder
    strFolderpath = CreateObject("WScript.Shell").SpecialFolders(16)
    On Error Resume Next
 
    ' Instantiate an Outlook Application object.
    Set objOL = CreateObject("Outlook.Application")
 
    ' Get the collection of selected objects.
    Set objSelection = objOL.ActiveExplorer.Selection
 
' The attachment folder needs to exist
' You can change this to another folder name of your choice
 
    ' Set the Attachment folder.
    strFolderpath = strFolderpath & "OLAttachments"
 
    ' Check each selected item for attachments.
    For Each objMsg In objSelection
 
    Set objAttachments = objMsg.Attachments
    lngCount = objAttachments.Count
         
    If lngCount > 0 Then
     
    ' Use a count down loop for removing items
    ' from a collection. Otherwise, the loop counter gets
    ' confused and only every other item is removed.
     
    For i = lngCount To 1 Step -1
     
    ' Get the file name.
    strFile = objAttachments.Item(i).FileName
     
    ' Combine with the path to the Temp folder.
    strFile = strFolderpath & strFile
     
    ' Save the attachment as a file.
    objAttachments.Item(i).SaveAsFile strFile
     
    Next i
    End If
     
    Next
     
ExitSub:
 
Set objAttachments = Nothing
Set objMsg = Nothing
Set objSelection = Nothing
Set objOL = Nothing
End Sub
.
0
NEW Veeam Agent for Microsoft Windows

Backup and recover physical and cloud-based servers and workstations, as well as endpoint devices that belong to remote users. Avoid downtime and data loss quickly and easily for Windows-based physical or public cloud-based workloads!

 

Author Comment

by:route217
ID: 38759557
Afternoon glow flow

Any development on the macro
0
 
LVL 31

Expert Comment

by:gowflow
ID: 38759771
Sorry was out and we hv snow storm here could not connect earlier. Yoiu mention your folder is CM Template but you didn't mention what is the path ?
0
 

Author Comment

by:route217
ID: 38759821
Hi glow flow

U can use c:\mydocument and ill change the file path later on...

Also I managed to find the follow vba whilst searching the web but cannot see how to change the code to extract any attachment coming on the cmu template email folder:


Option Explicit
Private Const MAX_PATH = 255

Private Declare Function GetTempPath Lib "kernel32" Alias "GetTempPathA" (ByVal nBufferLength As Long, ByVal lpBuffer As String) As Long

Then a couple of Functions:

Code:
Public Function SaveAttachments(Optional PathName As String) As Boolean

Dim oOutlook As Outlook.Application
Dim oNs As Outlook.NameSpace
Dim oFldr As Outlook.MAPIFolder
Dim oMessage As Object
Dim sPathName As String
Dim oAttachment As Outlook.Attachment
Dim iCtr As Integer
Dim iAttachCnt As Integer

On Error GoTo ErrHandler

If PathName = "" Then
    sPathName = GetTempDir
Else
    sPathName = PathName
End If

If Right(sPathName, 1) <> "\" Then sPathName = sPathName & "\"
If Dir(sPathName, vbDirectory) = "" Then Exit Function

Set oOutlook = New Outlook.Application
Set oNs = oOutlook.GetNamespace("MAPI")
Set oFldr = oNs.GetDefaultFolder(olFolderInbox)
For Each oMessage In oFldr.Items
With oMessage.Attachments
    iAttachCnt = .Count
    If iAttachCnt > 0 Then
        For iCtr = 1 To iAttachCnt
            .Item(iCtr).SaveAsFile sPathName _
                 & .Item(iCtr).FileName
        Next iCtr
    End If
End With
DoEvents

Next oMessage
SaveAttachments = True

ErrHandler:
Set oMessage = Nothing
Set oFldr = Nothing
Set oNs = Nothing
Set oOutlook = Nothing
End Function


Code:
Public Function GetTempDir() As String
    Dim sRet As String, lngLen As Long
    'create buffer
    sRet = String(MAX_PATH, 0)
    lngLen = GetTempPath(MAX_PATH, sRet)
    If lngLen = 0 Then Err.Raise Err.LastDllError
    GetTempDir = Left$(sRet, lngLen)
End Function


And your attachments are now in the folder!
Criticism comes easier than Craftmanship
0
 
LVL 31

Accepted Solution

by:
gowflow earned 500 total points
ID: 38759901
wait wait !!!!
the code you posted first is fine I made some small ammendments for it to work. The way it work (this is a temp solution if you like it then will find a better way to incorporate it) I will attach it to Excel file first you do this:

1) open outlook and locate the email and highlight it (just click on it) then run the excel make sure you enable macroes and click on the button Save File to C and then go to you Documents and look for folder OLAttachments and see what is there.

Let me know we can modify this to look for a complete folder and incorporate it to outlook so it is less cumbersome.

gowflow
saveattachments.xls
0
 

Author Comment

by:route217
ID: 38759942
Hi glow flow this is why I am after

"Let me know we can modify this to look for a complete folder and incorporate it to outlook so it is less cumbersome."

I'll post second part to this question...

Pa what do the second macro do...
0

Featured Post

Free Tool: ZipGrep

ZipGrep is a utility that can list and search zip (.war, .ear, .jar, etc) archives for text patterns, without the need to extract the archive's contents.

One of a set of tools we're offering as a way to say thank you for being a part of the community.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

When you have clients or friends from around the world, it becomes a challenge to arrange a meeting or effectively manage your time. This is where Outlook's capability to show 2 time zones in one calendar comes in handy.
This article describes a serious pitfall that can happen when deleting shapes using VBA.
This video shows how to remove a single email address from the Outlook 2010 Auto Suggestion memory. NOTE: For Outlook 2016 and 2013 perform the exact same steps. Open a new email: Click the New email button in Outlook. Start typing the address: …
Although Jacob Bernoulli (1654-1705) has been credited as the creator of "Binomial Distribution Table", Gottfried Leibniz (1646-1716) did his dissertation on the subject in 1666; Leibniz you may recall is the co-inventor of "Calculus" and beat Isaac…

615 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question