?
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
?
162 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
[X]
Welcome to Experts Exchange

Add your voice to the tech community where 5M+ people just like you are talking about what matters.

  • Help others & share knowledge
  • Earn cash & points
  • Learn & ask questions
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

Technology Partners: We Want Your Opinion!

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!

Question has a verified solution.

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

This article will help to fix the below errors for MS Exchange Server 2013 I. Certificate error "name on the security certificate is invalid or does not match the name of the site" II. Out of Office not working III. Make Internal URLs and Externa…
In this article I discuss my selections of the Top Four free Outlook OST File Viewers available. Open, view and read even damaged OST files by using these tools. They all provide a clear preview of all data such as emails, notes, tasks, calendars, e…
To add imagery to an HTML email signature, you have two options available to you. You can either add a logo/image by embedding it directly into the signature or hosting it externally and linking to it. The vast majority of email clients display l…
A short tutorial showing how to set up an email signature in Outlook on the Web (previously known as OWA). For free email signatures designs, visit https://www.mail-signatures.com/articles/signature-templates/?sts=6651 If you want to manage em…
Suggested Courses

752 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