Question

我现在要执行一个大型项目，将大约50个Outlook pst档案（大约100-200GB）导入并重组到我的货运公司的一个图书馆帐户中。

我正在使用Windows 10 Pro计算机，并在本地计算机上安装了Office 365商业高级版，而Outlook使用的是当前的“ Exchange Online”版本15.20.xxxx.xx，因此云中所有内容都可用。

导入存档不是问题。

我的问题是必须重命名数千个Outlook文件夹，以便它们井井有条！

最终目标是将所有电子邮件文件夹重命名为该公司为该货运设置的完整文件号：

CHI-AE0xxxxx (air export)
CHI-AI0xxxxx (air import)
CHI-OE0xxxxx (ocean export)
CHI-OI0xxxxx (ocean import)
CHI-DO0xxxxx (domestic)

其中x是数字，现在必须是6个数字

直到现在，还没有命名结构，所以每个人都在自己的大脑中使用任何有意义的东西。这里有一些例子：

CHOIxxxxx
CHOI0xxxxx
CHIOIxxxxx
CHIOI0xxxxx

或者只是xxxxx（我会知道需要将此前缀附加到此人的文件夹）

所以基本上我想要做的是用“ CHI-OI”替换“ CHOI”或“ CHIOI”，然后如果有5位数字，则将其变成6位数字，并以0开头。

我对Excel VBA和宏非常有经验。我非常擅长将Powershell与Excel和SQL Server数据库一起使用。

我没有使用Outlook的经验，也没有尝试使用VBA或Powershell之类的外部工具来操作它的经验，但是我愿意学习！

Answer 1

事实证明，Outlook VBA是完成此任务的方法。

昨天我终于找到了一个很好的答案：

https://www.datanumen.com/blogs/batch-find-replace-specific-words-outlook-folder-names/

我不得不通过替换来对代码进行一些修改：

Set objFolders = Outlook.Application.Session.Folders("Personal").Folders

这样，它仅搜索/修改我当前选择的文件夹中的子文件夹：

Set objFolders = Outlook.Application.ActiveExplorer.CurrentFolder.Folders

这是（几乎）完成的代码：

Public strFind, strReplace As String

Sub FindReplaceWordsinFolderNames()

    Dim objFolders As Outlook.Folders
    Dim objFolder As Outlook.Folder

    Set objFolders = Application.ActiveExplorer.CurrentFolder.Folders

    'You need to input the specific words for find and replace
    strFind = InputBox("Enter the specific words you want to change.")
    strReplace = InputBox("Enter the specific words you want to change to. (Case Sensitive)")

    For Each objFolder In objFolders
        Call ProcessFolders(objFolder)
    Next

    MsgBox "Complete!", vbExclamation, "Rename Folders"

End Sub

Private Sub ProcessFolders(ByVal objCurrentFolder As Outlook.Folder)
    Dim objSubfolder As Outlook.Folder

    On Error Resume Next
    If InStr(LCase(objCurrentFolder.Name), LCase(strFind)) > 0 Then
       'Find and replace the specific words
       objCurrentFolder.Name = Replace(LCase(objCurrentFolder.Name), LCase(strFind), strReplace)
    End If

    'Process all folders recursively
    If objCurrentFolder.Folders.Count > 0 Then
       For Each objSubfolder In objCurrentFolder.Folders
           Call ProcessFolders(objSubfolder)
       Next
    End If
End Sub

它没有任何错误检查，因此，如果我在输入框中单击“取消”或将其保留为空白，然后单击“确定”，则宏的作用类似于“”为strFind，因此它将所有文件夹名称都转换为小写，大声笑。

我认为在2个输入框之后添加此内容即可解决该问题，但明天我将对其进行测试：

    If strFind = "" Or strReplace = "" Then
        Exit Sub
    End If

这个解决方案对我来说似乎真的很不错，因为我需要解决的搜索字符串种类繁多，以至于每个人都很难进行硬编码。取而代之的是，这将使我能够即时调整每位用户多年来发展其个人命名结构时大脑的工作方式。

看到并使用它之后，我然后开发了另一个宏，以将所有内容从选定目录批量移动到我希望将它们合并到的任何文件夹中，以创建真正的文件库，但这是一个不同的主题，所以我想您不希望将其张贴在这里。

使用替换字符串批量重命名Outlook文件夹

1 个答案: