Solved

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

Posted on 2013-01-09
9
474 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 30

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
Free learning courses: Active Directory Deep Dive

Get a firm grasp on your IT environment when you learn Active Directory best practices with Veeam! Watch all, or choose any amount, of this three-part webinar series to improve your skills. From the basics to virtualization and backup, we got you covered.

 

Author Comment

by:route217
ID: 38759557
Afternoon glow flow

Any development on the macro
0
 
LVL 30

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 30

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
 

Author Comment

by:route217
ID: 38760141
0

Featured Post

Industry Leaders: We Want Your Opinion!

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!

Question has a verified solution.

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

Do you use a spreadsheet like Microsoft's Excel?  Have you ever wanted to link out to a non excel file on your computer or network drive?  This is the way I found to do it!
Many functions in Excel can make decisions. The most simple of these is the IF function: it returns a value depending on whether a condition you describe is true or false. Once you get the hang of using the IF function, you will find it easier to us…
A short tutorial showing how to set up an email signature in Outlook on the Web (previously known as OWA). For free email signatures designs, visit https://www.mail-signatures.com/articles/signature-templates/?sts=6651 If you want to manage em…

752 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