vba - 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
任何帮助将不胜感激。
解决方案
推荐阅读
- css - 如何在自定义 React 组件中使用 Material-UI 主题调色板颜色?
- javascript - VueJS 3 如何在两个非父/子组件之间触发方法
- wordpress - 我可以创建一个链接来跳转到新页面上的某个部分并打开某个 Divi 模块选项卡吗?
- javascript - 如何在点击时将字体真棒图标附加到段落
- eslint - 个人 ESLint 规则覆盖
- javascript - (节点:52585)UnhandledPromiseRejectionWarning:未处理的承诺拒绝
- java - 通过 ActiveMQ 代理插件发送消息
- python - 面向所有用户的 OneSignal SDK/API GET?
- flutter - 导航推需要钥匙吗?
- python - 在永不关闭的线程上记录到单个文件