none
Want VBScript Program To Copy Outlook E-Mail Items To External Folder

    Question

  • My Dear Friends,

    If you highlight one or more e-mail items in the Outlook Inbox, left-mouse button drag the selected items to your desktop, the selected items are copied to your desktop as <e-mail subject>.msg files.

    I am looking for a VBScript program that will perform the same function (except copying to a user-specified destination).

    I am only interested in VBScript solutions that copy e-mails to .msg files.  I am not interested in using .txt, .pst, or .ost files, etc.

    I can find examples on exporting e-mails to .txt files but this is not what I want.  The .msg file is an Outlook file that is readable by Outlook by simply clicking on the file.  It also seems to contain any attachments.

    I have modest programming skills.  I do my best at adapting and modifying examples to fit my needs.  Simple, fairly detailed descriptions of any suggestions would be much appreciated.

    Thanks much,

    SirHorace
    Denver
    • Edited by SirHorace Sunday, February 28, 2010 10:45 PM Correct punctuation
    Sunday, February 28, 2010 10:42 PM

Answers

  • My Dear Friends,

    If you highlight one or more e-mail items in the Outlook Inbox, left-mouse button drag the selected items to your desktop, the selected items are copied to your desktop as <e-mail subject>.msg files.

    I am looking for a VBScript program that will perform the same function (except copying to a user-specified destination).

    I am only interested in VBScript solutions that copy e-mails to .msg files.  I am not interested in using .txt, .pst, or .ost files, etc.

    I can find examples on exporting e-mails to .txt files but this is not what I want.  The .msg file is an Outlook file that is readable by Outlook by simply clicking on the file.  It also seems to contain any attachments.

    I have modest programming skills.  I do my best at adapting and modifying examples to fit my needs.  Simple, fairly detailed descriptions of any suggestions would be much appreciated.

    Thanks much,

    SirHorace
    Denver

    Hi Denver

    You may try the SaveAs option to save the email msg. to a local directory, SaveAs method accepts 2 parameters first is the path where you wanna store, it must be a full path including the filename. The next and the last parameter is the "Type" which is optional. This indicates the format you like the msg to be stored so have to pass one of the olDoc(4), olHTML(5), olMSG(3), olRTF(1), olTemplate(2), olTXT(0), olVCal(7), or olVCard(6) format constants


    You can try the below example code, just update you destination directory/path in the code.

       Set myOlApp = CreateObject("Outlook.Application")

       Set myItem = Me.Explorers.Item(1).Selection.Item(1)
       myItem.SaveAs "<Path>" & myItem.Subject & ".msg", olMSG

    Hope you can build up rest of your code further.

    Happy coding...
    -Kanagal.


    Monday, March 01, 2010 11:12 AM

All replies

  • My Dear Friends,

    If you highlight one or more e-mail items in the Outlook Inbox, left-mouse button drag the selected items to your desktop, the selected items are copied to your desktop as <e-mail subject>.msg files.

    I am looking for a VBScript program that will perform the same function (except copying to a user-specified destination).

    I am only interested in VBScript solutions that copy e-mails to .msg files.  I am not interested in using .txt, .pst, or .ost files, etc.

    I can find examples on exporting e-mails to .txt files but this is not what I want.  The .msg file is an Outlook file that is readable by Outlook by simply clicking on the file.  It also seems to contain any attachments.

    I have modest programming skills.  I do my best at adapting and modifying examples to fit my needs.  Simple, fairly detailed descriptions of any suggestions would be much appreciated.

    Thanks much,

    SirHorace
    Denver

    Hi Denver

    You may try the SaveAs option to save the email msg. to a local directory, SaveAs method accepts 2 parameters first is the path where you wanna store, it must be a full path including the filename. The next and the last parameter is the "Type" which is optional. This indicates the format you like the msg to be stored so have to pass one of the olDoc(4), olHTML(5), olMSG(3), olRTF(1), olTemplate(2), olTXT(0), olVCal(7), or olVCard(6) format constants


    You can try the below example code, just update you destination directory/path in the code.

       Set myOlApp = CreateObject("Outlook.Application")

       Set myItem = Me.Explorers.Item(1).Selection.Item(1)
       myItem.SaveAs "<Path>" & myItem.Subject & ".msg", olMSG

    Hope you can build up rest of your code further.

    Happy coding...
    -Kanagal.


    Monday, March 01, 2010 11:12 AM
  • Thanks Kanagal for your suggestion.  I have constructed the program below which demonstrates the solution.

    SirHorace
    '@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@

    'Save Selected E-Mails As Outlook Msg Files
    '
    'This program saves selected Outlook Inbox e-mail items
    'as Outlook Msg files in a user-specified location.

    'The Msg file name is the same as the e-mail subject line cleaned
    'of illegal characters by the function CleanString(strData).

    'In this example program I have appended a random number To the Msg file
    'name To prevent overwriting of existing like e-mail subject lines.

    'MSDN SaveAs method web page
    'http://msdn.microsoft.com/en-us/library/aa210279%28office.11%29.aspx

    'Thanks to SS. Kanagal, Jr. for key ideas enabeling me to solve the problem.

    Option Explicit

    ' Declare variables.
    Dim objOutlook, objNamespace, objFolder
    Dim strScriptPath, strScriptName, strScriptFolder, olMSG
    Dim objItem, j, SelectionStringStartPos, lngCount, intAttach
    Dim EMailSubjectString, SelectionString, TempSubjectString
    Dim SaveAsFilePath, Results

    'vbBinaryCompare = 0
    'vbTextCompare   = 1

    Const olFolderInbox = 6

    olMSG            = 3

    SelectionString = "FW: "        'String to look for in e-mail subject line
    SaveAsFilePath  = "C:\TMP\ZZZ\"    'Folder path to store e-mails

    Randomize    'Initialize random number generator

    ' Determine local path.
    strScriptPath   = Wscript.ScriptFullName
    strScriptName   = Wscript.ScriptName
    strScriptFolder = Left(strScriptPath, Len(strScriptPath) - Len(strScriptName) - 1)

    ' Retrieve Outlook Inbox folder.
    Set objOutlook   = CreateObject("Outlook.Application")
    Set objNamespace = objOutlook.GetNamespace("MAPI")

    Set objFolder    = objNameSpace.GetDefaultFolder(olFolderInbox)

    ' Enumerate messages in Inbox.
    Results        = "" 'Initialize debug text buffer (technically not needed)
    lngCount       = objFolder.Items.Count
    For j          = lngCount To 1 Step - 1

       Set objItem             = objFolder.Items(j)
       EMailSubjectString      = objFolder.Items(j)
       SelectionStringStartPos = Instr(UCase(EMailSubjectString), SelectionString)    'Search for string  

       If SelectionStringStartPos > 0 Then    'E-Mail subject line contains selection string
       
          TempSubjectString = CleanString(EMailSubjectString) 'Clean e-mail subject line of invalid characters, etc.
          TempSubjectString = TempSubjectString & " (" & Int(100000*Rnd()) & ")" 'Create Msg file name
          objFolder.Items(j).SaveAs SaveAsFilePath &  TempSubjectString & ".Msg", olMSG 'Save the e-mail
          Results = Results & TempSubjectString & vbCrLf 'Debug statement

       End If

    Next 'j

    'Clean Up.
    Set objOutlook   = Nothing
    Set objNamespace = Nothing
    Set objFolder    = Nothing
    Set objItem      = Nothing

    Wscript.Echo Results 'Debug statement
    Wscript.Quit

    '################################################################
    'This function cleans the e-mail subject of invalid or
    'undesirable characters
    'Source: http://www.outlookcode.com/codedetail_print.aspx?id=827
    '################################################################
    Function CleanString(strData)
        'Replace invalid strings.

        strData = Replace(strData, "´",   "'")
        strData = Replace(strData, "`",   "'")
        strData = Replace(strData, "{",   "(")
        strData = Replace(strData, "[",   "(")
        strData = Replace(strData, "]",   ")")
        strData = Replace(strData, "}",   ")")
        strData = Replace(strData, "  ",  " ")    'Replace two spaces with one space
        strData = Replace(strData, "   ", " ")    'Replace three spaces with one space    
        'Cut out invalid signs.
        strData = Replace(strData, ": ",  "_")    'Colan followded by a space
        strData = Replace(strData, ":",   "_")    'Colan with no space
        strData = Replace(strData, "/",   "_")
        strData = Replace(strData, "\",   "_")
        strData = Replace(strData, "*",   "_")
        strData = Replace(strData, "?",   "_")
        strData = Replace(strData, """",  "'")
        strData = Replace(strData, "<",   "_")
        strData = Replace(strData, ">",   "_")
        strData = Replace(strData, "|",   "_")
        CleanString = Trim(strData)
    End Function

    'This program may be easily modified to save e-mails in other file format types such as:
    'olDoc(4), olHTML(5), olMSG(3), olRTF(1), olTemplate(2), olTXT(0), olVCal(7), or olVCard(6)

    'Other Outlook folders can be accessed using the appropriate constants such as:
    'Const olFolderDeletedItems = 3
    'Const olFolderOutbox = 4
    'Const olFolderSentMail = 5
    'Const olFolderInbox = 6
    'Const olFolderDrafts = 16
    'Const olFolderJunk = 23

    Thursday, March 04, 2010 3:46 AM
  • Using your concept with some modification, I wrote a VBScript that can be accessed through the rules wizard in MS Outlook 2007.  The Outlook rules determine which messages will be saved into the directory.  Instead of using a random number appended to the file name, I used the time of the email.  This keeps the code nice and short.  Here it is:

    'Script to call from Outlook Mail Rule to save emails into a directory on the computer hard drive or mapped network drive.
    'Instructions: Make new outlook VB module with this code. Macros must be enabled.
    Sub Save_Inbox_Emails_to_File(MyItem As Outlook.MailItem)
    
    
      'Define Variables
      Dim SaveAsFilePath, EmailSubjectString
      Dim TempSubjectString, EmailDateTime
        
      'Folder path to store emails, string must end with \
      SaveAsFilePath = "C:\TEMP\"
        
      'Determine if there is a subject line in the email.
      If Len(MyItem.Subject) > 0 Then
        EmailSubjectString = MyItem.Subject
      Else
        EmailSubjectString = "No Subject"
      End If
      
      'Calculate file name by adding Email date and time to subject line
      EmailDateTime = MyItem.ReceivedTime
      TempSubjectString = EmailSubjectString & " at " & EmailDateTime
      TempSubjectString = CleanString(TempSubjectString)
       
      'Save the e-mail
      MyItem.SaveAs SaveAsFilePath & TempSubjectString & ".msg", olMSG
      'This program may be easily modified to save e-mails in other file format types such as:
      'olDoc(4), olHTML(5), olMSG(3), olRTF(1), olTemplate(2), olTXT(0), olVCal(7), or olVCard(6)
    
    End Sub
    
    
    '################################################################
    'This function cleans the e-mail subject of invalid or
    'undesirable characters
    'Source: http://www.outlookcode.com/codedetail_print.aspx?id=827
    '################################################################
    Function CleanString(strData)
      'Replace invalid strings.
    
      strData = Replace(strData, "´", "'")
      strData = Replace(strData, "`", "'")
      strData = Replace(strData, "{", "(")
      strData = Replace(strData, "[", "(")
      strData = Replace(strData, "]", ")")
      strData = Replace(strData, "}", ")")
      strData = Replace(strData, " ", " ")   'Replace two spaces with one space
      strData = Replace(strData, "  ", " ")  'Replace three spaces with one space
      'Cut out invalid signs.
      strData = Replace(strData, ": ", "_")   'Colan followded by a space
      strData = Replace(strData, ":", "_")   'Colan with no space
      strData = Replace(strData, "/", "_")
      strData = Replace(strData, "\", "_")
      strData = Replace(strData, "*", "_")
      strData = Replace(strData, "?", "_")
      strData = Replace(strData, """", "'")
      strData = Replace(strData, "<", "_")
      strData = Replace(strData, ">", "_")
      strData = Replace(strData, "|", "_")
      CleanString = Trim(strData)
    End Function

    Tuesday, June 08, 2010 11:21 PM
  • Hello please help me!

    I am trying to help a customer whom has told me her Outlook emails are appearing on her desktop.

    In doing research I have luckily stumbled across this thread.

    I suspect that someone has put a .vbs script on her computer but where would they put it so that it is always running?

    Where would I look so that I can delete it?

    She is using Microsoft Outlook 2007 on a Windows 7 machine. She is not connected to any kind of exchanger server.

    Thankyou very much indeed for any help you can offer me

    Monday, June 28, 2010 10:49 AM
  • This particular issue is a bit above my skill set but as an update to the original post, the function "CleanString" should include replacing the Tab character with an underscore or other valid file name character as shown below:

    Function CleanString(strData)
        'Replace invalid strings.

        strData = Replace(strData, "´",       "'")
        strData = Replace(strData, "`",       "'")
        strData = Replace(strData, "{",       "(")
        strData = Replace(strData, "[",       "(")
        strData = Replace(strData, "]",       ")")
        strData = Replace(strData, "}",       ")")
        strData = Replace(strData, "  ",       " ")    'Replace two spaces with one space
        strData = Replace(strData, "   ",      " ")    'Replace three spaces with one space   
        'Cut out invalid file name characters.
        strData = Replace(strData, ": ",      "_")    'Colan followded by a space
        strData = Replace(strData, ":",       "_")    'Colan with no space
        strData = Replace(strData, "/",       "_")
        strData = Replace(strData, "\",       "_")
        strData = Replace(strData, "*",       "_")
        strData = Replace(strData, "?",       "_")
        strData = Replace(strData, """",       "'")
        strData = Replace(strData, "<",      "_")
        strData = Replace(strData, ">",      "_")
        strData = Replace(strData, "|",       "_")
        strData = Replace(strData, Chr(9), "_")  'Replace Tab with underscore 
        CleanString = Trim(strData)
    End Function

     

    SirHorace

    Monday, June 28, 2010 12:10 PM
  • Hello SirHorace,

    Please tell me to look to find this .vbs script so that I can delete it.

    Where would it have to be located to affect Microsoft Outlook at startup?

    Thankyou for your help

    Tuesday, June 29, 2010 5:02 AM
  • Hello SirHorace,

    Please tell me to look to find this .vbs script so that I can delete it.

    Where would it have to be located to affect Microsoft Outlook at startup?

    Thankyou for your help


    Technically you probably have a VBA script in the background of Outlook. Push Alt-f11 while in outlook and it will bring up the programing environment and you can then check in there for any scripts.
    Tuesday, June 29, 2010 8:18 AM
  • Thankyou very much indeed again I didn't even know that existed in Outlook!

    Best regards

    hkp

    Tuesday, June 29, 2010 2:49 PM
  • My Dear hkp,

    You also might look in (for XP):

    Start => Settings => Control Panel => Scheduled Tasks

    to see if the program is scheduled to run at system startup or login, etc.

    If the program is actively running it will show up as "Wscript.exe" in the Task Manager process list.  Of course, any running VBScript program will also show up with the same name.

    Hope this helps.

    SirHorace

    Tuesday, June 29, 2010 7:19 PM
  • Hi there,

    First of all, sorry, since my programming skills are really poor; just getting started. I was wondering if there is any simple way to modify the above code so that a window prompts to the user every time the macro is run. This way, the user may select different locations (different folders in different networks drives, for instance), depending on their needs.

    Thanks very much in advance for your help.

     

    Kind regards

    Thursday, December 16, 2010 5:49 PM
  • Wow that worked a treat for me !!

    However, I noticed that in fact the time saved in the subject of the file is still the time sent rather than the time received.

    Also, is there anyway to do the same for messages sent - I can't see run script option available when the "Apply rule on messages I send" option is selected.

    Thanks a lot

    Friday, June 01, 2012 3:33 PM
  • You are replying to a thread that is years old and is closed.  Try starting a new thread with you code and question.

    Tricky OUtlook questions should be posted to the Outlook VBA developer forum.


    ¯\_(ツ)_/¯

    Friday, June 01, 2012 5:15 PM
  • Hi

    I realise that this is a very old question, but I would like to know how to attach that script to an event in MSOutlook.

    eg - i would like to highlight a message - press a button or right click or do something somewhere that will run that script, but my knowledge of programming Outlook is zilch.  I have experience in VBA with Excel and Access

    Any pointers would be greatly appreciated

    CT

    Thursday, July 12, 2012 9:24 AM
  • This thread is closed.  Your question is about Outlook and not about scripting.  You will need to post in the Outlook forum.


    ¯\_(ツ)_/¯


    • Edited by jrv Thursday, July 12, 2012 1:30 PM
    Thursday, July 12, 2012 1:29 PM