时间戳

首页 > 解决方案 > 使用替换字符串批量重命名 Outlook 文件夹

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

问题描述

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

我正在使用在本地计算机上安装了 Office 365 商业高级版的 Windows 10 Pro 计算机，而 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 等外部工具对其进行操作的经验，但我愿意学习！

标签： vbapowershelloutlook

解决方案

原来 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

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

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

推荐阅读