none
Microsoft Outlook RRS feed

  • Pergunta

  • Pessoal bom dia!

    tenho um script VBS que altera a pasta de armazenamento do Outlook Express 6. Funciona mto bem.

    Soh que estou migrando todos os PCs da empresa para Microsoft Outlook 2007.
    Alguém sabe se tem como eu alterar a pasta de armazenamento do Microsoft Outlook 2007 via VBS e como?
    Grato
    quinta-feira, 21 de janeiro de 2010 12:53

Respostas

  • Olá,

    Verifique o script abaixo:

    on error resume next
    '************************************************************************

    'DESCRIPTION:   Move only archive PSTs to network and reconfigure outlook                                                       

    'WRITTEN BY:    Daniel M. Jones                                           

    'DATE:            October 28, 2009                                           

    'COMMENT:        Adopted from move-pst-to-networks by Mark Chamberlain

    '************************************************************************



    '************************************************************************

    ' VARIABLE DEFINITION

    '************************************************************************



    set objFSO = CreateObject("Scripting.FileSystemObject")

    set objNetwork = WScript.CreateObject("WScript.Network")

    set objWMI = GetObject("winmgmts:{impersonationLevel=impersonate}!\\.\root\cimv2")



    strUser = lcase(objNetwork.UserName)

    'ALTERE ESTA LINHA PARA INCLUIR O COMPARTILHAMENTO
    strCaminho = "\\server\compartilhamento\"

    strNetworkPath = strCaminho & strUser & "\"

    If Not objFSO.FolderExists(strNetworkPath) Then
        objFSO.CreateFolder(strNetWorkPath)
    End if

    '************************************************************************

    ' FUNCTIONS

    '************************************************************************



    function getStore(strHexID)

        for i = 1 to len(strHexID) step 2

            strSubString = mid(strHexID, i, 2)

            if (strSubString <> "00") then

                strPath = strPath & chrw("&H" & strSubString)

            end if

        next



        if (inStr(strPath, ":\")) then getStore = mid(strPath, inStr(strPath,":\") - 1)

        if (inStr(strPath, "\\")) then getStore = mid(strPath, inStr(strPath,"\\") - 1)

    end function



    '************************************************************************

    ' BEGIN

    '************************************************************************



    set dicPaths = CreateObject("Scripting.Dictionary")

    set dicExcludedPaths = CreateObject("Scripting.Dictionary")

    set objOutlook = CreateObject("Outlook.Application")

    set objNS = objOutlook.GetNamespace("MAPI")



    'Get all PSTs from all Outlook stores.

    for each objStore in objNS.Folders

        strStore = getStore(objStore.StoreID)

        strStorePath = left(strStore, inStrRev(strStore, "\"))

        strStoreFile = mid(strStore, inStrRev(strStore, "\") + 1)
    wscript.echo strPath
    wscript.echo strStorepath

        if instr(strPath,".pst"> 0) then

            set objFiles = objFSO.GetFolder(strStorePath).Files

            for each objFile in objFiles

                if (lcase(right(objFile.Name, 4) = ".pst")) then

                    dicPaths.Add objFile.Name, objFile.Path

                    if (objFile.Name = strStoreFile) then objOutlook.Session.RemoveStore objStore

                end if

            next

        else
            dicExcludedPaths.Add strStoreFile, strPath

        end if

    next



    'Exclude non-archive PST paths

    for each strKey in dicExcludedPaths.Keys

        if (dicPaths.Exists(strKey)) then

            dicPaths.Remove(strKey)

        end if

    next



    'kill outlook

    objOutlook.Session.Logoff

    objOutlook.Quit

    set colProcesses = objWMI.ExecQuery("Select * from Win32_Process where Name='OUTLOOK.EXE'")

    for each objProcess in colProcesses

        objProcess.Terminate()

    next

    wscript.sleep 2000





    'Copy PST to network and add to new store

    set objOutlook = CreateObject("Outlook.Application")

    set objNS = objOutlook.GetNamespace("MAPI")

    for each strKey in dicPaths.Keys   

        strPath = dicPaths(strKey)

        objFSO.CopyFile strPath, strNetworkPath

        strFileName = mid(strPath, inStrRev(strPath, "\") + 1)

        objNS.AddStore strNetworkPath & strFileName

    next   



    objOutlook.Session.Logoff

    objOutlook.Quit



    Até mais,

    Jesiel

    Obs.: Se útil, classifique

    • Marcado como Resposta PhoenixBR terça-feira, 26 de janeiro de 2010 15:43
    segunda-feira, 25 de janeiro de 2010 17:51

Todas as Respostas

  • Olá,

    Para alterar o o caminho padrão.. você pode alterar por GPO, baixando os templates (.adm):

    http://www.microsoft.com/downloads/details.aspx?FamilyId=73d955c0-da87-4bc2-bbf6-260e700519a8&displaylang=en


    Agora, se você quer mudar um pst já existente para um novo caminho... é um pouco trabalhoso. Dá uma olhada no link abaixo:

    http://www.tek-tips.com/viewthread.cfm?qid=1575977&page=1


    O script do link acima conecta na base, verifica o caminho dos pst´s copia para o novo caminho, deleta do outlook e recria no outlook com o novo caminho.


    Até mais,

    Jesiel

    Obs.: Se útil, classifique


    quinta-feira, 21 de janeiro de 2010 13:58
  • Desculpa minha ignorância, mas na entendi mto bem, preciso apenas mudar minha pasta de armazenamento padrão para:
    "x:\outlook"
    por favor me ajudem,
    vlw
    segunda-feira, 25 de janeiro de 2010 10:54
  • Olá,

    É só seguir o segundo link que te passei.

    segunda-feira, 25 de janeiro de 2010 11:49
  • Jesiel, tentei mas n consegui, onde eu deveria alterar nesse codigo para alterar a pasta de 
    armazenamento para "X:\OUTLOOK\". Grato

    '************************************************************************
    'DESCRIPTION: Move only archive PSTs to network and reconfigure outlook
    'WRITTEN BY: Daniel M. Jones
    'DATE: October 28, 2009
    'COMMENT: Adopted from move-pst-to-networks by Mark Chamberlain
    '************************************************************************

    '************************************************************************
    ' VARIABLE DEFINITION
    '************************************************************************

    set objFSO = CreateObject("Scripting.FileSystemObject")
    set objNetwork = WScript.CreateObject("WScript.Network")
    set objWMI = GetObject("winmgmts:{impersonationLevel=impersonate}!\\.\root\cimv2")

    strUser = lcase(objNetwork.UserName)
    strNetworkPath = "c:\temp\archive\" '"\\server\" & strUser & "\OutlookPST\"

    '************************************************************************
    ' FUNCTIONS
    '************************************************************************

    function getStore(strHexID)
    for i = 1 to len(strHexID) step 2
    strSubString = mid(strHexID, i, 2)
    if (strSubString <> "00") then
    strPath = strPath & chrw("&H" & strSubString)
    end if
    next

    if (inStr(strPath, ":\")) then getStore = mid(strPath, inStr(strPath,":\") - 1)
    if (inStr(strPath, "\\")) then getStore = mid(strPath, inStr(strPath,"\\") - 1)
    end function

    '************************************************************************
    ' BEGIN
    '************************************************************************

    set dicPaths = CreateObject("Scripting.Dictionary")
    set dicExcludedPaths = CreateObject("Scripting.Dictionary")
    set objOutlook = CreateObject("Outlook.Application")
    set objNS = objOutlook.GetNamespace("MAPI")

    'Get all PSTs from all Outlook stores.
    for each objStore in objNS.Folders
    strStore = getStore(objStore.StoreID)
    strStorePath = left(strStore, inStrRev(strStore, "\"))
    strStoreFile = mid(strStore, inStrRev(strStore, "\") + 1)
    if (objStore.Name = "Archive Folders") then
    set objFiles = objFSO.GetFolder(strStorePath).Files
    for each objFile in objFiles
    if (lcase(right(objFile.Name, 4) = ".pst")) then
    dicPaths.Add objFile.Name, objFile.Path
    if (objFile.Name = strStoreFile) then objOutlook.Session.RemoveStore objStore
    end if
    next
    else
    dicExcludedPaths.Add strStoreFile, strPath
    end if
    next

    'Exclude non-archive PST paths
    for each strKey in dicExcludedPaths.Keys
    if (dicPaths.Exists(strKey)) then
    dicPaths.Remove(strKey)
    end if
    next

    'kill outlook
    objOutlook.Session.Logoff
    objOutlook.Quit
    set colProcesses = objWMI.ExecQuery("Select * from Win32_Process where Name='OUTLOOK.EXE'")
    for each objProcess in colProcesses
    objProcess.Terminate()
    next
    wscript.sleep 2000


    'Copy PST to network and add to new store
    set objOutlook = CreateObject("Outlook.Application")
    set objNS = objOutlook.GetNamespace("MAPI")
    for each strKey in dicPaths.Keys
    strPath = dicPaths(strKey)
    objFSO.CopyFile strPath, strNetworkPath
    strFileName = mid(strPath, inStrRev(strPath, "\") + 1)
    objNS.AddStore strNetworkPath & strFileName
    next

    objOutlook.Session.Logoff
    objOutlook.Quit

    msgbox "done"
    segunda-feira, 25 de janeiro de 2010 14:50
  • Olá,

    Altere a linha:

    strNetworkPath = "c:\temp\archive\" '"\\server\" & strUser & "\OutlookPST\"
    Para por exemplo:

    strNetworkPath = "\\server\outlook\"

    No inicio do script, coloque:

    on error resume next

    Para evitar erro se encontrar arquivo do exchange.

    Os script só funcionará se não tiver senha no .pst. Se tiver, o script só irá copiar (não irá conectar novamente via outlook).

    Até mais,

    Jesiel

    Obs.: Se útil, classifique

    segunda-feira, 25 de janeiro de 2010 15:52
  • Fiz da forma como vc explicou acima, o script executa com sucesso sem erro, porém, qdo eu entro no Outlook e verifico em:
    Ferramentas\Opções na Guia "Configurar Email" e clico no botão "Arquivos de dados", a pasta de armazenamento continua a mesma não altera nda, será que estou fazendo certo? Grato
    segunda-feira, 25 de janeiro de 2010 16:33
  • Olá,

    Verifique o script abaixo:

    on error resume next
    '************************************************************************

    'DESCRIPTION:   Move only archive PSTs to network and reconfigure outlook                                                       

    'WRITTEN BY:    Daniel M. Jones                                           

    'DATE:            October 28, 2009                                           

    'COMMENT:        Adopted from move-pst-to-networks by Mark Chamberlain

    '************************************************************************



    '************************************************************************

    ' VARIABLE DEFINITION

    '************************************************************************



    set objFSO = CreateObject("Scripting.FileSystemObject")

    set objNetwork = WScript.CreateObject("WScript.Network")

    set objWMI = GetObject("winmgmts:{impersonationLevel=impersonate}!\\.\root\cimv2")



    strUser = lcase(objNetwork.UserName)

    'ALTERE ESTA LINHA PARA INCLUIR O COMPARTILHAMENTO
    strCaminho = "\\server\compartilhamento\"

    strNetworkPath = strCaminho & strUser & "\"

    If Not objFSO.FolderExists(strNetworkPath) Then
        objFSO.CreateFolder(strNetWorkPath)
    End if

    '************************************************************************

    ' FUNCTIONS

    '************************************************************************



    function getStore(strHexID)

        for i = 1 to len(strHexID) step 2

            strSubString = mid(strHexID, i, 2)

            if (strSubString <> "00") then

                strPath = strPath & chrw("&H" & strSubString)

            end if

        next



        if (inStr(strPath, ":\")) then getStore = mid(strPath, inStr(strPath,":\") - 1)

        if (inStr(strPath, "\\")) then getStore = mid(strPath, inStr(strPath,"\\") - 1)

    end function



    '************************************************************************

    ' BEGIN

    '************************************************************************



    set dicPaths = CreateObject("Scripting.Dictionary")

    set dicExcludedPaths = CreateObject("Scripting.Dictionary")

    set objOutlook = CreateObject("Outlook.Application")

    set objNS = objOutlook.GetNamespace("MAPI")



    'Get all PSTs from all Outlook stores.

    for each objStore in objNS.Folders

        strStore = getStore(objStore.StoreID)

        strStorePath = left(strStore, inStrRev(strStore, "\"))

        strStoreFile = mid(strStore, inStrRev(strStore, "\") + 1)
    wscript.echo strPath
    wscript.echo strStorepath

        if instr(strPath,".pst"> 0) then

            set objFiles = objFSO.GetFolder(strStorePath).Files

            for each objFile in objFiles

                if (lcase(right(objFile.Name, 4) = ".pst")) then

                    dicPaths.Add objFile.Name, objFile.Path

                    if (objFile.Name = strStoreFile) then objOutlook.Session.RemoveStore objStore

                end if

            next

        else
            dicExcludedPaths.Add strStoreFile, strPath

        end if

    next



    'Exclude non-archive PST paths

    for each strKey in dicExcludedPaths.Keys

        if (dicPaths.Exists(strKey)) then

            dicPaths.Remove(strKey)

        end if

    next



    'kill outlook

    objOutlook.Session.Logoff

    objOutlook.Quit

    set colProcesses = objWMI.ExecQuery("Select * from Win32_Process where Name='OUTLOOK.EXE'")

    for each objProcess in colProcesses

        objProcess.Terminate()

    next

    wscript.sleep 2000





    'Copy PST to network and add to new store

    set objOutlook = CreateObject("Outlook.Application")

    set objNS = objOutlook.GetNamespace("MAPI")

    for each strKey in dicPaths.Keys   

        strPath = dicPaths(strKey)

        objFSO.CopyFile strPath, strNetworkPath

        strFileName = mid(strPath, inStrRev(strPath, "\") + 1)

        objNS.AddStore strNetworkPath & strFileName

    next   



    objOutlook.Session.Logoff

    objOutlook.Quit



    Até mais,

    Jesiel

    Obs.: Se útil, classifique

    • Marcado como Resposta PhoenixBR terça-feira, 26 de janeiro de 2010 15:43
    segunda-feira, 25 de janeiro de 2010 17:51
  • Josiel c tah me ajudando bastante, deu certinho alterou o caminho, soh naum excluiu o caminho anterior, me ajuda nessa ai vlw
    terça-feira, 26 de janeiro de 2010 11:45
  • Olá,

    Altere esta Parte:

    'Copy PST to network and add to new store

    set objOutlook = CreateObject("Outlook.Application")

    set objNS = objOutlook.GetNamespace("MAPI")

    for each strKey in dicPaths.Keys   

        strPath = dicPaths(strKey)

        objFSO.CopyFile strPath, strNetworkPath
        objFSO.deletefile strPath

        strFileName = mid(strPath, inStrRev(strPath, "\") + 1)

        objNS.AddStore strNetworkPath & strFileName

    next   


    Até mais,

    Jesiel

    Obs.: Se útil, classifique

    terça-feira, 26 de janeiro de 2010 12:51
  • obrigado pela ajuda :)
    terça-feira, 26 de janeiro de 2010 15:43