troubleshooting Question

Outlook macro that saves arrived emails attachments into a folder. want it to save in 2 placed rather than 1.

Avatar of bsharath
bsharathFlag for India asked on
8 Comments1 Solution526 ViewsLast Modified:

Outlook macro that saves arrived emails attachments into a folder. want it to save in 2 placed rather than 1.
At present it saves in the below path
Const saveFolder As String = "D:\SophosMailAttachments\"
Can i also save in this path

in the same way as now.
Sub SaveAttachment_NoStrip(ByRef mai As Outlook.MailItem)
Dim objItem As Object
Dim mailAtt As Attachment
Dim intAtt As Integer
Dim saver As String
Dim constsaver As String
Dim fn As String
Dim ft As String
Dim Subject As String
Dim del As Variant
Const sendereMailTrigger As String = ""
Const saveFolder As String = "D:\SophosMailAttachments\"
     On Error GoTo exitsub
     If LCase(mai.sendereMailAddress) <> LCase(sendereMailTrigger) Then Exit Sub
    If mai.Attachments.Count > 0 Then
        If Right(saveFolder, 1) = "\" Then
            constsaver = saveFolder
            constsaver = saveFolder & "\"
        End If
        constsaver = constsaver & Format(Date, "yyyy-mm-dd") & "\"
        md constsaver, True
        For intAtt = 1 To mai.Attachments.Count
            Subject = Replace(mai.ConversationTopic, """", " ")
            For Each del In Array("/", ":", "*", "?", "<", ">", "|")
                Subject = Replace(Subject, del, " ")
            Subject = Left(Subject, 250 - 16 - Len(constsaver))
            saver = constsaver & Subject & "_" & Left(mai.Attachments.Item(intAtt).FileName, InStr(mai.Attachments.Item(intAtt).FileName, ".") - 1) & "_" & Format(Date, "yyyy-mm-dd") & "." & Right(mai.Attachments.Item(intAtt).FileName, Len(mai.Attachments.Item(intAtt).FileName) - InStr(mai.Attachments.Item(intAtt).FileName, "."))
            mai.Attachments.Item(intAtt).SaveAsFile saver
    End If
End Sub
Join our community to see this answer!
Unlock 1 Answer and 8 Comments.
Start Free Trial
Learn from the best

Network and collaborate with thousands of CTOs, CISOs, and IT Pros rooting for you and your success.

Andrew Hancock - VMware vExpert
See if this solution works for you by signing up for a 7 day free trial.
Unlock 1 Answer and 8 Comments.
Try for 7 days

”The time we save is the biggest benefit of E-E to our team. What could take multiple guys 2 hours or more each to find is accessed in around 15 minutes on Experts Exchange.

-Mike Kapnisakis, Warner Bros