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

【问题标题】：Bulk rename Outlook Folders using replace strings使用替换字符串批量重命名 Outlook 文件夹
【发布时间】：2021-01-14 10:17:04
【问题描述】：

我现在的任务是为我的货运代理公司导入和重组大约 50 个 Outlook pst 档案（可能大约 100-200GB）到一个库帐户中。

我使用的是在本地计算机上安装了 Office 365 商业高级版的 Windows 10 专业版计算机，而 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（我会知道需要附加到此人文件夹的前缀）

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

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

我没有使用 Outlook 和/或尝试使用 VBA 或 Powershell 等外部工具对其进行操作的经验，但我愿意学习！

【问题讨论】：

您到底需要什么帮助？您需要尝试一些事情，然后发布一个特定问题，无论是如何在 Outlook 中重命名文件夹（参见例如vbaexpress.com/forum/…）还是如何将现有文件夹名称标准化为所需的标准（这只是普通的 VBA 和不是特定于 Outlook 的）
你能写一个脚本来查看每个文件名并输出当前文件名和你想要的文件名吗？那将是一个很好的起点。至少您可以在问题中发布一些内容，以便有人提出一些建议。

标签： vba powershell outlook

【解决方案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

这个解决方案对我来说似乎真的很好，因为我需要处理各种各样的搜索字符串，每一个都进行硬编码将是一场噩梦。相反，这将使我能够即时调整每个用户多年来开发个人命名结构时的大脑工作方式。

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

【讨论】：