【发布时间】：2011-09-18 20:12:52
【问题描述】：
在工作中，我们选择了一个新的交换服务器，所以我的老板会让我到我们所有的计算机上，手动将人们拥有的所有打开的 PST 文件移动到他们在新服务器上的文件夹中。出于显而易见的原因，我决定编写脚本会更简单。经过一番研究，我发现了一个这样的脚本，它只需要一点调整（在这里找到http://halfloaded.com/blog/logon-script-move-local-pst-files-to-network-share/）但还有很多其他我不需要的东西（检查它是否在笔记本电脑上运行，只影响本地文件夹等），所以我将主要逻辑从其中蚕食到我自己的版本中，而没有进行大多数这些健全性检查。我遇到的问题是我有 2 个看似相同的循环迭代不同的次数，这会导致问题。这就是我所拥有的
Option Explicit
Const OverwriteExisting = True
' get username, will use later
Dim WshNetwork: Set WshNetwork = wscript.CreateObject("WScript.Network")
Dim user: user = LCase(WshNetwork.UserName)
Set WshNetwork = Nothing
' network path to write pst files to
Dim strNetworkPath : strNetworkPath = "\\server\folder\"
'Fix network path if forgot to include trailing slash...
If Not Right(strNetworkPath,1) = "\" Then strNetworkPath = strNetworkPath & "\" End If
' initiate variables and instantiate objects
Dim objOutlook, objNS, objFolder, objFSO, objFName, objTextFile, pstFiles, pstName, strPath
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objTextFile = objFSO.CreateTextFile("c:\My\Desktop\pst_script_log.txt " , True)
Set objOutlook = CreateObject("Outlook.Application")
Set objNS = objOutlook.GetNamespace("MAPI")
Dim count : count = -1
' Enumerate PST filesand build arrays
objTextFile.Write("Enumerating PST files" & vbCrLf)
For Each objFolder in objNS.Folders
If GetPSTPath(objFolder.StoreID) <> "" Then
pstFiles = GetPSTPath(objFolder.StoreID)
pstName = objFolder.Name
count = count + 1
objTextFile.Write(count & " " & pstFiles & vbCrLf)
ReDim Preserve arrNames(count)
arrNames(count) = pstName
ReDim Preserve arrPaths(count)
arrPaths(count) = pstFiles
objOutlook.Session.RemoveStore objFolder
End IF
Next
' closes the outlook session
objOutlook.Session.Logoff
objOutlook.Quit
Set objOutlook = Nothing
Set objNS = Nothing
' quits if no pst files were found
If count < 0 Then
wscript.echo "No PST Files Found."
wscript.Quit
End If
objTextFile.Write("moving them" & vbCrLf)
' moves the found pst files to the new location
Dim pstPath
For Each pstPath In arrPaths
On Error Resume Next
objTextFile.Write(pstPath & vbCrLf)
objFSO.MoveFile pstPath, strNetworkPath
If Err.Number <> 0 Then
wscript.sleep 5000
objFSO.MoveFile pstPath, strNetworkPath
End If
Err.Clear
On Error GoTo 0
Next
Set objFSO = Nothing
' sleep shouldn't be necessary, but was having issues believed to be related to latency
wscript.sleep 5000
'Re-open outlook
Set objOutlook = CreateObject("Outlook.Application")
Set objNS = objOutlook.GetNamespace("MAPI")
'Re-map Outlook folders
For Each pstPath In arrPaths
objTextFile.Write("Remapping " & pstPath & " to " & strNetworkPath & Mid(pstPath, InStrRev(pstPath, "\") + 1) & vbCrLf)
objNS.AddStore strNetworkPath & Mid(pstPath, InStrRev(pstPath, "\") + 1)
Next
count = -1
For Each objFolder In objNS.Folders
If GetPSTPath(objFolder.StoreID) <> "" Then
count = count + 1
objTextFile.Write("Renaming " & GetPSTPath(objFolder.StoreID) & " to " & arrNames(count) & vbCrLf)
objFolder.Name = arrNames(count)
End If
Next
objOutlook.Session.Logoff
objOutlook.Quit
objTextFile.Write("Closing Outlook instance and unmapping obj references...")
Set objFolder = Nothing
Set objTextFile = Nothing
Set objOutlook = Nothing
Set objNS = Nothing
wscript.echo "Done."
wscript.Quit
Private Function GetPSTPath(byVal input)
'Will return the path of all PST files
' Took Function from: http://www.vistax64.com/vb-script/
Dim i, strSubString, strPath
For i = 1 To Len(input) Step 2
strSubString = Mid(input,i,2)
If Not strSubString = "00" Then
strPath = strPath & ChrW("&H" & strSubString)
End If
Next
Select Case True
Case InStr(strPath,":\") > 0
GetPSTPath = Mid(strPath,InStr(strPath,":\")-1)
Case InStr(strPath,"\\") > 0
GetPSTPath = Mid(strPath,InStr(strPath,"\\"))
End Select
End Function
有问题的循环位于第 24 行和第 81 行。具体错误是第二个循环中的计数比第一个循环增加得更多，但这是因为第一个循环的迭代次数不足并且缺少最后一个 PST 文件。在我发现大部分代码的网站上遇到类似问题的人说，在某些地方添加 wscript.sleep 函数对他们有帮助，但我在他们推荐的地方没有这样的运气，我觉得他们的问题是和我的不一样。
对于我的代码中出现的问题，我非常感谢帮助，我愿意接受有关纠正其他我没有看到的问题的建议，并认为有更好的方法来做这样的事情。
EDI：在对我的问题进行了更多研究之后，似乎通过在第 24 行的循环内执行 RemoveStore，我正在更改 objNS.Folders 的值（这是有道理的），为了避免这种情况，我应该存储我需要删除的 objFolder 项目并在另一个循环中执行此操作。现在的问题是我不知道该怎么做，我试过了
[line 35]
ReDim Preserve arrFolders(count)
arrFolders(count) = objFolder
End If
Next
For Each objFolder in arrFolders
objOutlook.Session.RemoveStore objFolder
Next
但是，我收到有关 RemoveStore 的类型不匹配错误，因此我认为它没有按需要存储对象。有什么想法吗？
【问题讨论】：
-
很抱歉，这不能回答您的问题，因此只是评论：我尝试支持相同的方案，从文件共享打开 Exchange + Outlook + PST 文件。当您的网络出现故障时，Outlook 将被锁定，您将接到有关 Outlook 崩溃的电话，而不是弄清楚网络出现了什么问题。
-
我还建议在磁盘中搜索 PST 文件。并非每个人都始终保持所有这些负载。真是一团糟……
-
@Rocjoe：我们没有遇到任何真正的网络问题，而且我们的办公室小到足以让我的老板或我自己大喊 Exchange 已关闭，每个人都会知道 :) 我非常感谢您的建议尽管。 @Brad：我有一些通过 FSO 对象迭代 PST 的东西，一旦我开始工作，我可能会将其添加到此结束，但是现在我想确保打开的 PST 文件以相同的方式重新打开名称，所以这是一个无缝的体验。谢谢
-
我已经让它工作了，但是我不会让我发布它，因为我对这个网站还很陌生（尽管潜伏了很长时间）。有空会发。