AutoSubrogateŽ

Outlook Macro

If you arrived here from my blog website autosubrogate.com, please continue. If you did not arrive here from my blog website, this web page is not for you.
 
Saving an Outlook E-Mail message in a computer file like a document with its associated case file record.

Use your mouse pointer to select ALL the text (Press Left Mouse Button [LMB] down and hold it there till you have selected all the source code text) between the two lines of '+' signs exclusive of the two lines of '+' signs. When your mouse pointer gets close to the bottom edge of the Window frame, slowly and gently tough the tip of the mouse pointer to the bottom edge of the Window frame. Keep that LMB held down till you get to the last line of source code. The text will scroll down. You can hold the mouse pointer against the bottom edge of the window frame to make the text scroll down continuously, but this is a touchy process that requires some finesse that you may have to acquire by trial and error. Good luck! Continue doing this till the last line of text is selected; i.e., becomes reverse video. It will finish quicker if you don't rush it. If the process of selecting all the text gets messed up, you can just left click the mouse pointer inside of the window frame to deselect all the selected text and start over. The text is "read only". So you can not change it or mess it up in any way. There are about 56 lines of text to select. Once ALL the text is selected, press Ctrl-C to copy it to your clip-board. Then resume following the instructions that got you here in the first place. Please remember what I said about being able to find your way back. You can close this Window later at any time. It's not critical, and you can't break anything here. So don't worry about it. Don't waste your time trying to get back to this web-page by selecting an item on the website main menu. This web-page is not on the website main menu even though it may look like it is. Don't waste your time exploring the menu in the left sidebar on this web-page. It's from the website I had before the one you are using now (the one that got you here). There is nothing there of value to you. I have my reasons for keeping it. Without it I wouldn't be able to make this work for you, and it is too complicated to explain. I write too much as it is already.
 
Ted Palmer 

++++++++++++++++++++++++++++++++++++++++++++++++++++ 
 
'2009-11-19 Ted Palmer
'Created Subroutine
'This subroutine will do a "SaveAs" of whatever e-mail message the user has open
'in the Inspector window. It will use the e-mail subject as a basis for the filename.
Public Sub SaveAsEmail2AutoSubrogate()
    On Error GoTo Error_Exit
    Dim IE As InternetExplorer
    Dim intResultYesNo As Integer
    Dim gs_MMSaveAsDrive As String
    gs_MMSaveAsDrive = "C:" '<-- Change to 'C' for local machine or drive letter mapped to a 'Share on server'.
    Dim myItem As Outlook.Inspector
    Dim objItem As Object
    Dim strMyFileNmbr As String
    Dim strMyFileName As String
    Dim strMsg As String
    Set myItem = Application.ActiveInspector
    If Not TypeName(myItem) = "Nothing" Then
        Set objItem = myItem.CurrentItem
        'Use the subject for the filename but 1st remove all the characters that are not valid in a filename.
        strMyFileName = Left(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace( _
        objItem.Subject, "\", ""), "/", ""), ":", ""), "*", ""), "?", ""), "<", ""), ">", ""), "|", ""), ".", ""), """", ""), vbTab, ""), Chr(7), ""), 250) & ".msg"
        'Prompt the user for the MyFile Number.
        strMyFileNmbr = InputBox("For Technical Support contact" & vbCrLf & _
        "http://www.autosubrogate.com" & vbCrLf & vbCrLf & _
        "Enter the MyFile # for this E-Mail message." & vbCrLf & vbCrLf & _
        "Be sure that this is the most recent e-mail message in a sequence of replys " & _
        "because this message will be saved to a file that deletes any previous saved files based on " & _
        "the subject of this message with characters that are invalid in filenames removed.", _
        "AutoSubrogate® - Save E-mail for ", "")
        If Trim(strMyFileNmbr) <> "" Then
            objItem.SaveAs gs_MMSaveAsDrive & "\AutoSubrogate -- The Share folder\AutoSubrogate\MyFiles\" & strMyFileNmbr & "\E-Mails\" & strMyFileName, olMSG
            strMsg = "The selected E-mail was saved to MyFile # " & strMyFileNmbr & "."
            intResultYesNo = MsgBox(strMsg, vbExclamation + vbOKOnly, "AutoSubrogate® - Success")
        Else
            strMsg = "No MyFile # was entered. Operation aborted." & vbCrLf & vbCrLf & _
                     "Do you want to contact AutoSubrogate® Technical Support?"
            intResultYesNo = MsgBox(strMsg, vbQuestion + vbYesNo + vbDefaultButton1, "AutoSubrogate® - Operation aborted. -- MyFile # is null")
            If intResultYesNo = vbYes Then
                Set IE = CreateObject("InternetExplorer.Application")
                IE.navigate ("http://WWW.AUTOSUBROGATE.COM")
                IE.Visible = True
                GoTo Exit_Sub
            Else
                GoTo Exit_Sub
            End If
        End If
    Else
        MsgBox "There is no current active Inspector. There must be an E-mail message open in the Inspector to use this function.", vbExclamation, "AutoSubrogate® - SaveAsEmail2AutoSubrogate"
        GoTo Exit_Sub
    End If
    GoTo Exit_Sub
Error_Exit:
    Select Case Err.Number
        Case -2147287037
            strMsg = "The MyFile # you entered " & strMyFileNmbr & " does not exist in the AutoSubrogate® directory structure. " & _
                     "Or the directory structure defined in the macro doesn't match the well ordered directory structure on your system." & vbCrLf & vbCrLf & _
                     "Do you want to contact AutoSubrogate® Technical Support?"
            intResultYesNo = MsgBox(strMsg, vbQuestion + vbYesNo + vbDefaultButton1, "AutoSubrogate® - SaveAsEmail2AutoSubrogate -- Case -2147287037")
            If intResultYesNo = vbYes Then
                Set IE = CreateObject("InternetExplorer.Application")
                IE.navigate ("http://WWW.AUTOSUBROGATE.COM")
                IE.Visible = True
                GoTo Exit_Sub
            Else
                GoTo Exit_Sub
            End If
        Case Else
            strMsg = "There was an unhandled Exception thrown. OS error information follows: " & vbCrLf & vbCrLf & _
                     "Error Number: " & Err.Number & vbCrLf & vbCrLf & _
                     "Err.Description: " & Err.Description & vbCrLf & vbCrLf & _
                     "Do you want to contact AutoSubrogate® Technical Support?"
            intResultYesNo = MsgBox(strMsg, vbQuestion + vbYesNo + vbDefaultButton1, "AutoSubrogate® - SaveAsEmail2AutoSubrogate -- unhandled Exception thrown")
            If intResultYesNo = vbYes Then
                Set IE = CreateObject("InternetExplorer.Application")
                IE.navigate ("http://WWW.AUTOSUBROGATE.COM")
                IE.Visible = True
                GoTo Exit_Sub
            Else
                GoTo Exit_Sub
            End If
    End Select
   
    Exit Sub
Exit_Sub:
    'Set IE = CreateObject("InternetExplorer.Application")
    'IE.navigate ("http://WWW.AUTOSUBROGATE.COM")
    'IE.Visible = True
End Sub

 
++++++++++++++++++++++++++++++++++++++++++++++++++++ 
 

Copyright © Theodore L Palmer 2015. All rights reserved.
 
LEGAL DISCLAIMER: The information at this web site is for advertising and general information purposes only. This information is offered "as is" without warranty of any kind including a warranty of merchantability or fitness for a particular purpose and does not constitute a legally binding contract. I recommend you contact my firm, Palmer Info Tech, LLC for specific questions.

Palmer Info Tech, LLC * P.O. Box 27906 * St. Louis * MO * 63146