我正在尝试使用VBA中的regex表达式从邮件正文中找到某个字符串及其关联的值,但我得到了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
任何帮助将不胜感激。