Results 1 to 2 of 2
  1. #1

    Moving/Saving files to disk (Outlook 2000)

    Greetings all,
    I've turned towards you all again in hopes of conquering my latest solution...
    I use the following script to save e-mails to disk and move them from my inbox to a separate folder.
    Sub Save_And_Move()
    On Error GoTo ErrHandler
    Dim msg As Collection
    Dim ObjItem As Object
    Dim lngC As Long
    Dim userinits As String
    Dim strFileName As String
    Dim intCounter As Integer
    Set mynamespace = Application.GetNamespace("MAPI")
    Set myinbox = mynamespace.GetDefaultFolder(6)
    Set mydestfolder = myinbox.Folders("Unclassified")
    Set msg = New Collection

    'Add item(s) selected to Collection
    If TypeName(Outlook.ActiveWindow) = "Explorer" Then
    For lngC = 1 To ActiveExplorer.Selection.Count
    msg.Add Outlook.ActiveExplorer.Selection(lngC)
    Next lngC
    msg.Add Outlook.ActiveInspector.CurrentItem
    End If

    'Handle each message in collection as follows
    For Each ObjItem In msg
    With ObjItem

    'Remove illegal characters from filename
    strFileName = Trim(Replace(.Subject, ":", " "))
    strFileName = Replace(strFileName, "<", " ")
    strFileName = Replace(strFileName, ">", " ")
    strFileName = Replace(strFileName, """", " ")
    For intCounter = 1 To Len(strFileName)
    If InStr(1, "/|*?", Mid(strFileName, intCounter, 1)) > 0 Then
    Mid(strFileName, intCounter, 1) = " "
    End If

    'Save File to disk as text, mark as unread
    strFileName = strFileName & ".txt"
    .SaveAs "A:" & strFileName, olTXT
    .UnRead = False

    'Move to the Desired Folder
    .Move mydestfolder
    End With
    Next ObjItem

    'Clear all VARS, Escape Hatch, and Error Handler
    Set msg = Nothing
    Set mynamespace = Nothing
    Set myinbox = Nothing
    Set mydestfolder = Nothing

    Exit Sub

    MsgBox "You must either insert a disk or select a message for this function to work properly. Check to ensure the Destination folder is directly below the INBOX in the hierarchy. Please check both and try again."
    End Sub

    The computer guru's have come up w/ a new way of handling all of our messages by placing them into a public folder for further transfer to disk, but this script (obviously) won't work w/ the public folders since I'm assuming they're mapped differently than the inbox... Does anyone know how I could structure this to work from saving messages from a public folder called "IN" and moving it to a folder called "UNCLAS".
    Any ideas?
    Thanks in advance,
    Dan Schlangen

  2. #2
    Plutonium Lounger
    Join Date
    Mar 2002
    Thanked 31 Times in 31 Posts

    Re: Moving/Saving files to disk (Outlook 2000)

    You must know the complete path of the public folder. Let's say it is Public FoldersAll Public FoldersSalesIN. You can refer to this folder as

    Dim mySourceFolder As MAPIFolder
    Set mySourceFolder = myNameSpace.Folders("Public Folders").Folders("All Public Folders").Folders("Sales").Folders("IN")

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts