Usuário com melhor resposta
Microsoft Outlook

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
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
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
-
-
-
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" -
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
-
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 -
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
-
-
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
-