Question

我正在编写一个VBA脚本以用作Outlook宏。目标是根据主题行中的案例编号自动将电子邮件分类到文件夹中。

首先我尝试使用“类似字符串”功能，可以选择正确的电子邮件，但我需要更多的灵活性，所以我尝试使用正则表达式。到目前为止，这是我的代码。我已经卡住了

(catching(classOf[IllegalArgumentException]) either DateTime.parse(str))
  .right.map(JsSuccess(_))
  .left.map(t => JsError(t.getMessage))
  .fold(identity, identity)

尝试编译错误的结果：“编译错误：找不到方法或数据成员”

我已经在网上搜索了我做错了什么，但我认为match.count应该是有效的。我没有VB经验，所以我很感激任何具体的提示。

完整代码：

   If objMatch.Count > 0 Then

编辑：我还有几个步骤。新代码：

Option Explicit
Sub FoldalotMacro()
Dim fdr As String
Dim CaseFolders As Folder

Dim strEmail As String
Dim RegEx As RegExp
Dim objMatch As Match
Dim objMatches As MatchCollection
Set RegEx = CreateObject("vbscript.regexp")
With RegEx
    .Pattern = ".*(68\d{7})(.{0,20}).*"
    .IgnoreCase = True
    .Global = False
End With

Dim Sel, Item

  ' ** Source: Items to be processed
  Set Sel = Outlook.Session.Folders("My Name").Folders("Inbox").Folders("caseinbox").Items
  ' ** Target folder
  Set CaseFolders = Outlook.Session.Folders("My Name").Folders("Inbox").Folders("casetest")

  For Each Item In Sel
   Set objMatch = RegEx.Execute(Item.Subject)
   ' ** Run Regex against item subject
   If objMatch.Count > 0 Then
   ' ** folder title is the extracted case number
        Set fdr = objMatch.Item(0).SubMatches(0)
        ' ** create the folder if it does not exist
        If CaseFolders.Folders(fdr) Is Nothing Then CaseFolders.Folders.Add fdr
        End If
        Item.Move CaseFolders.Folders(fdr)
    Else
    ' ** alert if no action
        Debug.Print "no match found"
    End If
End Sub

陷入这一部分：

    ' process manually
Option Explicit
Sub FoldalotMacro()
Dim fdr As String
Dim CaseFolders As Outlook.Folder
Dim Counter As Long
Dim strEmail As String
Dim Sel2 As Outlook.Folder
Dim Item As Object
Dim Sel

Dim RegEx As RegExp
Dim objMatch As Match
Dim objMatches As MatchCollection
Dim submatches As submatches
Set RegEx = New RegExp
With RegEx
    .Pattern = ".*(6\d{8})(.{0,20}).*"
    .IgnoreCase = True
    .Global = False
End With

  '  Source: Items to be processed
Set Sel2 = Outlook.Session.Folders("My Name").Folders("Inbox").Folders("caseinbox")
Set Sel = Sel2.Items
  '  Target folder
  Set CaseFolders = Outlook.Session.Folders("My Name").Folders("Inbox").Folders("casetest")

    For Each Item In Sel
        Set objMatches = RegEx.Execute(Item.Subject)
         '  Run Regex against item subject
        If objMatches.Count > 0 Then
            fdr = objMatches.Item(0)
            If CaseFolders.Folders(fdr) Is Nothing Then CaseFolders.Folders.Add fdr
            Item.Move CaseFolders.Folders(fdr)
        Else
            MsgBox "No match found:  " & Item.Subject
        End If
    Next

End Sub

我将fdr定义为String以使其工作，但要搜索文件夹名称，它需要一个对象。我应该为fdr定义什么？

Answer 1

你需要

If objMatch.Length > 0 Then

(see here)

另外，您似乎有一个引用设置为VBScript RegExp库，但是您使用后期绑定来创建您的RegEx对象：

Dim RegEx As RegExp '// Early bound
Set RegEx = CreateObject("vbscript.regexp") '// Late bound

而只是做：

Dim RegEx As RegExp
Set RegEx = New RegExp

Answer 2

Dim RegEx As RegExp
Dim objMatch As Match
Dim objMatches As MatchCollection

如果该代码编译，那么你显然有一个对正则表达式库的引用; Macro Man's answer是正确的，您没有任何理由使用CreateObject创建一个您可以New向上的类的实例。

可以使用对象浏览器（VBE中的 F2 ）浏览所有引用的库：

Members of 'Match'

Match类没有Count成员，因此当您键入此内容时（假设您键入）：

If objMatch.Count > 0 Then

您没有注意 IntelliSense 告诉您的内容：

IntelliSense listing members of Match in a dropdown

Execute方法不返回Match个对象。当然，这并不明显，因为Execute方法会返回Object，这几乎可以是任何东西，对吗？使用TypeName，您可以找到真相：

Sub DoSomething()

    With New RegExp
        .Pattern = "\w"
        Dim result As Object
        Set result = .Execute("foo bar")
        Debug.Print TypeName(result)
    End With

End Sub

打印IMatchCollection2 - 显然由MatchCollection类型实现的界面：Execute因此返回匹配集合对象。

IMatchCollection hidden interface

所以不要这样：

Set objMatch = RegEx.Execute(Item.Subject)

这样做：

Set objMatches = RegEx.Execute(Item.Subject)

然后迭代该集合中的Match个对象。

Answer 3

工作方案：（我添加了一些评论，希望对下一个人有所帮助）

Option Explicit
Private Function FolderExists(Inbox As MAPIFolder, FolderName As String)
    Dim Sub_Folder As MAPIFolder

    On Error GoTo Exit_Err
    Set Sub_Folder = Inbox.Folders(FolderName)

    FolderExists = True
        Exit Function

Exit_Err:
    FolderExists = False

End Function

Sub FoldalotMacro()
Dim fdr As String
Dim CaseFolders As Outlook.Folder
Dim SubFolder As Outlook.MAPIFolder
Dim Sel2 As Outlook.Folder
Dim Item As Object
Dim Sel

Dim RegEx As RegExp
Dim objMatch As Match
Dim objMatches As MatchCollection
Dim submatches As submatches
Set RegEx = New RegExp
With RegEx
' Change this regex pattern to suit your needs. 
    .Pattern = ".*(6\d{8})(.{0,20}).*"
    .IgnoreCase = True
    .Global = False
End With


  '  Source: Items to be processed
Set Sel2 = Outlook.Session.Folders("Account Name").Folders("Inbox").Folders("SourceFolderName")
Set Sel = Sel2.Items
  '  Target folder
  Set CaseFolders = Outlook.Session.Folders("Account Name").Folders("Inbox").Folders("DestinationRootFolder")
    For Each Item In Sel
        Set objMatches = RegEx.Execute(Item.subject)
         '  Run Regex against item subject. is there a match?
        If objMatches.Count > 0 Then
            ' Folder name will be the extracted number
            fdr = objMatches.Item(0).submatches(0)
            ' Check if folder already exists
            If FolderExists(CaseFolders, fdr) = True Then
                Set SubFolder = CaseFolders.Folders(fdr)
            Else
                ' Create the folder if it does not exist
                Set SubFolder = CaseFolders.Folders.Add(fdr)
            End If
            Item.Move SubFolder
        End If
    Next
End Sub

我还有一个小问题：运行宏时，它应该处理源文件夹中的所有项目。但它只处理4-7个，然后停止。如果我再次跑，它会移动一些，依此类推。我进行了调试，发现所有内容都选择正确，但是＆＃34; Item.move＆＃34;仍然只在列表中移动一些随机数尽管如此，我最初的问题已经回答了，谢谢大家：）

正则表达式错误无法编译Match.Count

3 个答案: