?
Solved

Check the txt file and move all folder paths that are in the file to 1 specific location.

Posted on 2010-01-12
2
Medium Priority
?
167 Views
Last Modified: 2012-05-08
Hi,

Check the txt file and move all folder paths that are in the file to 1 specific location.
I have paths like this
\\Latest Mails\Inbox\UtoZ\Sha
\\All\Inbox\AtoZ\Vi D
\\Latest Mails\Inbox\UtoZ\Vijay

Need to move all to this path

\\Mailbox -Sharath\inbox

Can anyone help me with a script that can do this

Regards
Sharath
0
Comment
Question by:bsharath
2 Comments
 
LVL 59

Accepted Solution

by:
Chris Bottomley earned 2000 total points
ID: 26357451
See the snippet:

Modify:
Const FilePathandName As String = "c:\deleteme\pstFolderPaths.txt"
to point to your file

It uses the function olkNav2Folder that I have supplied but make sure there is only one copy in your module.

Chris
Sub q25048442()
Const FilePathandName As String = "c:\deleteme\pstFolderPaths.txt"
Dim inputFile As Object
Dim FSO As Object
Dim strFolders As String
Dim arrFolders() As String
Dim fldr As Variant
Dim moveFolder As Object
Dim moveToFolder As Object
    
    Set FSO = CreateObject("scripting.filesystemobject")
    If FSO.FileExists(FilePathandName) Then
        Set inputFile = FSO.openTextFile(FilePathandName, 1, True)
        strFolders = inputFile.ReadAll
        inputFile.Close
        arrFolders = Split(strFolders, vbCrLf)
        Set inputFile = Nothing
    Else
        Set inputFile = Nothing
        strFolders = ""
    End If
    Set FSO = Nothing
    
    Set moveToFolder = olkNav2Folder("\\Mailbox -Sharath\inbox", False)
    Set moveToFolder = olkNav2Folder("\\Personal folders\drafts", False)
    If Not moveToFolder Is Nothing Then
        For Each fldr In arrFolders
            If fldr <> "" Then
                Set moveFolder = olkNav2Folder(CStr(fldr), False)
                If Not moveFolder Is Nothing Then
                    moveFolder.moveTo moveToFolder
                Else
                    MsgBox "Folder " & CStr(fldr) & " NOT found", vbExclamation, "Folder Error"
                End If
            End If
        Next
    End If

End Sub

Public Function olkNav2Folder(foldername As String, Optional createFolders As Boolean) As Object
Dim olApp As Object
Dim olNS As Object
Dim olfldr As Object
Dim reqdFolder As Object
Dim arrFolders() As String
Dim nestCount As Integer

    On Error Resume Next
    foldername = Replace(Replace(foldername, "/", "\"), "\\", "")
    If Right(foldername, 1) = "\" Then foldername = Left(foldername, Len(foldername) - 1)
    arrFolders() = Split(foldername, "\")
    Set olApp = CreateObject("Outlook.Application")
    Set olNS = olApp.GetNamespace("MAPI")
    Set reqdFolder = olNS.folders.Item(arrFolders(0))
    For nestCount = 1 To UBound(arrFolders)
        If Not reqdFolder Is Nothing Then
            Set olfldr = reqdFolder.folders
            Set reqdFolder = olfldr.Item(arrFolders(nestCount))
            If reqdFolder <> olfldr.Item(arrFolders(nestCount)) Then
                If createFolders Then
                    reqdFolder.folders.Add (arrFolders(nestCount))
                    Set olfldr = reqdFolder.folders
                    Set reqdFolder = olfldr.Item(arrFolders(nestCount))
                Else
                    Set reqdFolder = Nothing
                    Exit For
                End If
            End If
        Else
        End If
    Next
    Set olkNav2Folder = reqdFolder
    Set olApp = Nothing
    Set olNS = Nothing
    Set olfldr = Nothing
    Set reqdFolder = Nothing
End Function

Open in new window

0
 
LVL 11

Author Comment

by:bsharath
ID: 26357580
Thanks Chris works perfect....
0

Featured Post

Free Tool: Path Explorer

An intuitive utility to help find the CSS path to UI elements on a webpage. These paths are used frequently in a variety of front-end development and QA automation tasks.

One of a set of tools we're offering as a way of saying thank you for being a part of the community.

Question has a verified solution.

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

This article lists the top 5 trialware OST to PST Converter Tools. These tools save a lot of time for users when they want to convert OST to PST after their Exchange server is no longer available or other critical issues with Exchange server or impo…
Mailbox Corruption is a nightmare every Exchange DBA wishes he never has. Recovering from it can be super-hectic if not entirely futile. And though techniques like the New-MailboxRepairRequest cmdlet have been designed to help with fixing minor corr…
There are cases when e.g. an IT administrator wants to have full access and view into selected mailboxes on Exchange server, directly from his own email account in Outlook or Outlook Web Access. This proves useful when for example administrator want…
There may be issues when you are trying to access Outlook or send & receive emails or due to Outlook crash which leads to corrupt or damaged PST file. To eliminate the corruption from your PST file, you need to repair the corrupt Outlook PST file. U…
Suggested Courses

571 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