首页 > 解决方案 > SubMatches 函数 VBA 中的运行时错误

问题描述

我正在尝试使用 VBA 中的正则表达式从邮件正文中找到某个字符串及其相关值,但我得到了Runtime error 5 Invalid procedure call or argument,但我找不到解决方案。

错误即将上线MsgBox M.SubMatches(1)

总体而言,我正在尝试将整个电子邮件作为 PDF 以及所有附件导出到特定文件夹。我想将 PDF 命名为从正则表达式中找到的值。

Sub SaveWithoutBox()

    'Get all selected items
    Dim MyOlNamespace As Outlook.NameSpace
    Set MyOlNamespace = Application.GetNamespace("MAPI")
    Set MyOlSelection = Application.ActiveExplorer.Selection

    'Make sure at least one item is selected
    If MyOlSelection.Count <> 1 Then
       Response = MsgBox("Please select a single item", vbExclamation, "Save as PDF")
       Exit Sub
    End If

    'Retrieve the selected item
    Set MySelectedItem = MyOlSelection.Item(1)

    'Get the user's TempFolder to store the item in
    Dim FSO As Object, TmpFolder As Object
    Set FSO = CreateObject("scripting.filesystemobject")
    Set tmpFileName = FSO.GetSpecialFolder(2)

    'construct the filename for the temp mht-file
    strName = "shanilsoni"
    tmpFileName = tmpFileName & "\" & strName & ".mht"

    'Save the mht-file
    MySelectedItem.SaveAs tmpFileName, olMHTML

    'Open the mht file in MS Word
    Set objWordApp = CreateObject("Word.Application")
    Set objWordDoc = objWordApp.Documents.Open(tmpFileName, False)

    'Set file name to subject
    Dim msgFileName As String
    msgFileName = MySelectedItem.Subject

    Dim Reg1 As RegExp
    Dim M1 As MatchCollection
    Dim M As Match
    Dim filenameregex As String
    Set Reg1 = New RegExp
    With Reg1
        'Demo string: "Reference number: US8617687AHSJ918
        .Pattern = "Reference number:+\s*(\w*)\s*"
        .Global = True
    End With

    If Reg1.test(MySelectedItem.Body) Then
        Set M1 = Reg1.Execute(MySelectedItem.Body)
        For Each M In M1
            MsgBox M.SubMatches(1) 'Error coming here in debugging
            Set filenameregex = M.SubMatches(1)
        Next
    End If

    'Change the local folder to save the PDF file
    strPDF = "D:\Test\" & filenameregex & ".pdf"

    'Export the current mht file as a PDF file
    objWordApp.ActiveDocument.ExportAsFixedFormat strPDF, wdExportFormatPDF

    objWordDoc.Close
    objWordApp.Quit

    'Cleanup
    Set MyOlNamespace = Nothing
    Set MyOlSelection = Nothing
    Set MySelectedItem = Nothing
    Set objWordDoc = Nothing
    Set objWordApp = Nothing

    Dim individualItem As Object
    Dim att As Attachment
    Dim strPath As String
    Dim dicFileNames As Object

    strPath = "D:\Test\"

    Set dicFileNames = CreateObject("Scripting.Dictionary")

    For Each individualItem In Application.ActiveExplorer.Selection
        If TypeName(individualItem) = "MailItem" Then
            Dim j As Integer
            j = 1
            For Each att In individualItem.Attachments
                dicFileNames.Add att.FileName, 1
                att.SaveAsFile strPath & att.FileName
            Next att
        End If
    Next individualItem

End Sub

任何帮助将不胜感激。

标签: vbaoutlook

解决方案


推荐阅读