?
Solved

Outlook 2007. Save attachment 2 times. Once to specific location, again to user-designated folder.

Posted on 2012-09-17
9
Medium Priority
?
385 Views
Last Modified: 2012-09-24
I want to open an email and run a macro (from ribbon is fine--I got that part).

I want to be prompted for a 4-digit number. The number gets punched in (example: 6677)

I want the macro to save the *.LIC file to:
\\MyBigFolder\MyLittleFolder\6677

(where 6677 is the 4-digit number entered by user, and it looks like we'll need 5 digits before you know it)

And to ALSO save it, without user intervention, to the folder named:

\\192.168.100.9\pas\Hospital Licenses

That would be incredible. :)

I could probably figure out the 2nd save using the first-save code.
0
Comment
Question by:Dreamboat
  • 5
  • 4
9 Comments
 
LVL 59

Expert Comment

by:Chris Bottomley
ID: 38408911
Not sure about the syntax for the last part but hopefully this helps!

Sub savetwo(mai As Object)
Dim strIdent As String
Dim bolRetry As Boolean
Dim strQualifier As String
Dim fso As Object
Dim strFileSpec As String

    If TypeName(mai) <> "MailItem" Then
        MsgBox "Aborting Loop as incorrect object type supplied"
        Exit Sub
    End If
    If mai.Attachments.Count = 0 Then
        MsgBox "Aborting Loop as no attachments found for the supplied object"
        Exit Sub
    End If
    bolRetry = True
    Do While bolRetry
        strIdent = InputBox(strQualifier & "Enter the Series Identifier :>", "User Prompt")
        If strIdent = "" Then
            MsgBox "Aborting Loop with a null input"
            Exit Sub
        ElseIf Len(strIdent) < 4 Or Len(strIdent) > 4 Then
            strQualifier = "Input length incorrect" & vbCrLf & vbCrLf
        ElseIf Not IsNumeric(strIdent) Then
            strQualifier = "Input must be numeric" & vbCrLf & vbCrLf
        Else
            bolRetry = False
        End If
    Loop
    strFileSpec = "\\MyBigFolder\MyLittleFolder\" & strIdent & "\"
    md strFileSpec, True
    strFileSpec = strFileSpec & mai.Attachments(1).filename
    
    mai.Attachments(1).SaveAsFile strFileSpec
    
Set fso = Nothing
End Sub

Function md(dosPath As String, Optional createFolders As Boolean)
' Modified to account for UNC paths
Dim fso As Object
Dim fldrs() As String
Dim rootdir As String
Dim fldrIndex As Integer
Dim arr() As String
Dim elem As Integer
Dim strFilePath As String
    
    md = True
    Set fso = CreateObject("Scripting.FileSystemObject")
    If Not fso.FolderExists(dosPath) Then
        If Left(dosPath, 2) = "\\" Then
            dosPath = Right(dosPath, Len(dosPath) - 2)
            fldrs = Split(dosPath, "\")
            fldrs(0) = "\\" & fldrs(0)
        Else
            fldrs = Split(dosPath, "\")
        End If
        If UBound(fldrs) = 1 Then
            md = False
            Exit Function
        Else
            strFilePath = fldrs(0)
            For elem = 1 To UBound(fldrs)
                strFilePath = strFilePath & "\" & fldrs(elem)
                If Not fso.FolderExists(strFilePath) Then
                    If createFolders Then
                        fso.CreateFolder strFilePath
                    Else
                        md = False
                        Exit Function
                    End If
                End If
            Next
        End If
    End If
End Function

Open in new window


Chris
0
 
LVL 22

Author Comment

by:Dreamboat
ID: 38409095
Can't wait to try it, Chris! Leaving for work now.
0
 
LVL 22

Author Comment

by:Dreamboat
ID: 38409201
Apparently, Outlook macros that contain something in the parentheses aren't available to run? (I have looked and looked to find why, and can't.)

Sub savetwo(mai As Object)

Must become

Sub savetwo()

So, of course, I try to run it like that and get the abort loop error.
0
What does it mean to be "Always On"?

Is your cloud always on? With an Always On cloud you won't have to worry about downtime for maintenance or software application code updates, ensuring that your bottom line isn't affected.

 
LVL 59

Expert Comment

by:Chris Bottomley
ID: 38410555
Apologies I didn't define the calling mechanism ... I made it a parameter to allow the sub to be used from both code and a rule.  Therefore re-instate the parameter then call for example as:

savetwo application.activeexplorer.selection(1)

assuming an item is selected in the explorer window.

Chris
0
 
LVL 22

Author Comment

by:Dreamboat
ID: 38412027
"an item is selected"

You mean a message? I'm not in Explorer, I am in Outlook saving an attachment.
0
 
LVL 59

Expert Comment

by:Chris Bottomley
ID: 38412381
The outlook activeexplorer is a reference to the folder in outlooks folder pane where the current item is selected

Replacing:

savetwo application.activeexplorer.selection(1)
with
savetwo application.activeinspector.currentitem

To work with the last opened outlook item

Chris
0
 
LVL 22

Author Comment

by:Dreamboat
ID: 38420064
Okay, it's prompting for the number now. Phew!

I don't need it to create the folder if it doesn't exist. If it doesn't exist, it's a bad folder number. Could I have it throw an error "Folder doesn't exist" with an OK button? I have no idea what all parts of the code to remove.

Thanks so much!!
0
 
LVL 59

Accepted Solution

by:
Chris Bottomley earned 2000 total points
ID: 38420353
On a different machine, (code could be simplified in respect of the function but will work fine with the following ... I think) :

Sub savetwo(mai As Object)
Dim strIdent As String
Dim bolRetry As Boolean
Dim strQualifier As String
Dim fso As Object
Dim strFileSpec As String

    If TypeName(mai) <> "MailItem" Then
    End If
    If mai.Attachments.Count = 0 Then
        MsgBox "Aborting Loop as no attachments found for the supplied object"
        Exit Sub
    End If
    bolRetry = True
    Do While bolRetry
        strIdent = InputBox(strQualifier & "Enter the Series Identifier :>", "User Prompt")
        If strIdent = "" Then
            MsgBox "Aborting Loop with a null input"
            Exit Sub
        ElseIf Len(strIdent) < 4 Or Len(strIdent) > 4 Then
            strQualifier = "Input length incorrect" & vbCrLf & vbCrLf
        ElseIf Not IsNumeric(strIdent) Then
            strQualifier = "Input must be numeric" & vbCrLf & vbCrLf
        Else
            bolRetry = False
        End If
    Loop
    strFileSpec = "\\MyBigFolder\MyLittleFolder\" & strIdent & "\"
    if md( strFileSpec, False) = false then
        MsgBox "Aborting Loop ... Folder i.e. Series Identifier NOT found"
        Exit Sub
    end if
    strFileSpec = strFileSpec & mai.Attachments(1).filename
    
    mai.Attachments(1).SaveAsFile strFileSpec
    
Set fso = Nothing
End Sub

Function md(dosPath As String, Optional createFolders As Boolean)
' Modified to account for UNC paths
Dim fso As Object
Dim fldrs() As String
Dim rootdir As String
Dim fldrIndex As Integer
Dim arr() As String
Dim elem As Integer
Dim strFilePath As String
    
    md = True
    Set fso = CreateObject("Scripting.FileSystemObject")
    If Not fso.FolderExists(dosPath) Then
        If Left(dosPath, 2) = "\\" Then
            dosPath = Right(dosPath, Len(dosPath) - 2)
            fldrs = Split(dosPath, "\")
            fldrs(0) = "\\" & fldrs(0)
        Else
            fldrs = Split(dosPath, "\")
        End If
        If UBound(fldrs) = 1 Then
            md = False
            Exit Function
        Else
            strFilePath = fldrs(0)
            For elem = 1 To UBound(fldrs)
                strFilePath = strFilePath & "\" & fldrs(elem)
                If Not fso.FolderExists(strFilePath) Then
                    If createFolders Then
                        fso.CreateFolder strFilePath
                    Else
                        md = False
                        Exit Function
                    End If
                End If
            Next
        End If
    End If
End Function

Open in new window


Chris
0
 
LVL 22

Author Comment

by:Dreamboat
ID: 38428361
I'm sure this will work, I simply haven't had a chance to try it out. Thanks, Chris, for all your help!
0

Featured Post

Receive 1:1 tech help

Solve your biggest tech problems alongside global tech experts with 1:1 help.

Question has a verified solution.

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

There can be many situations demanding the conversion of Outlook OST files to PST format and as such, there is no shortage of automated tools to perform this conversion. However, what makes Stellar OST to PST converter stand above the rest? Let us e…
MS Outlook undoubtedly is the most widely used email client.Its user-friendliness, cost effectiveness, and availability with Microsoft Office Suite make it the most popular email application.  Its compatibility with Microsoft applications like Exch…
This Experts Exchange video Micro Tutorial shows how to tell Microsoft Office that a word is NOT spelled correctly. Microsoft Office has a built-in, main dictionary that is shared by Office apps, including Excel, Outlook, PowerPoint, and Word. When …
Whether it be Exchange Server Crash Issues, Dirty Shutdown Errors or Failed to mount error, Stellar Phoenix Mailbox Exchange Recovery has always got your back. With the help of its easy to understand user interface and 3 simple steps recovery proced…
Suggested Courses

621 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