我发现了一些vba,将创建一个文本文件的outlook电子邮件的主体.然而,一个问题是,它不保存创建的文本文件.任何人都有任何关于如何让新创建的文本文件保存的想法?下面的代码.
Sub ExportUrlToTextFileFromEmail()
'UpdatebyExtendoffice20220413
Dim xMail As Outlook.MailItem
Dim xRegExp As RegExp
Dim xMatchCollection As MatchCollection
Dim xMatch As Match
Dim xUrl As String, xSubject As String, xFileName As String
Dim xFs As FileSystemObject
Dim xTextFile As Object
Dim i As Integer
Dim InvalidArr
On Error Resume Next
If Application.ActiveWindow.Class = olInspector Then
Set xMail = ActiveInspector.CurrentItem
ElseIf Application.ActiveWindow.Class = olExplorer Then
Set xMail = ActiveExplorer.Selection.Item(1)
End If
Set xRegExp = New RegExp
With xRegExp
.Pattern = "(https?[:]//([0-9a-z=\?:/\.&-^!#$;_])*)"
.Global = True
.IgnoreCase = True
End With
If xRegExp.test(xMail.Body) Then
InvalidArr = Array("/", "\", "*", ":", Chr(34), "?", "<", ">", "|")
xSubject = xMail.Subject
For i = 0 To UBound(InvalidArr)
xSubject = VBA.Replace(xSubject, InvalidArr(i), "")
Next i
xFileName = "Z:\" & xSubject & ".txt"
Set xFs = CreateObject("Scripting.FileSystemObject")
Set xTextFile = xFs.CreateTextFile(xFileName, True)
xTextFile.WriteLine (vbCrLf)
Set xMatchCollection = xRegExp.Execute(xMail.Body)
i = 0
For Each xMatch In xMatchCollection
xUrl = xMatch.SubMatches(0)
i = i + 1
'xTextFile.WriteLine (i & ". " & xUrl & vbCrLf)
xTextFile.WriteLine (xUrl & vbCrLf)
Next
xTextFile.Close
Set xTextFile = Nothing
Set xMatchCollection = Nothing
Set xFs = Nothing
Set xFolderItem = CreateObject("Shell.Application").Namespace(0).ParseName(xFileName)
xFolderItem.InvokeVerbEx ("open")
Set xFolderItem = Nothing
End If
Set xRegExp = Nothing
End Sub
我试着写xTextfile.save,但似乎不起作用
2条答案
按热度按时间ndasle7k1#
您找到的代码试图在Z驱动器的根目录中创建文本文件
也许您的计算机上没有Z驱动器,或者您没有将文件保存到Z驱动器根目录的权限。
尝试将此行更改为实际要保存文件的位置,类似于:
beq87vna2#
SubMatches
集合包含单独的子匹配字符串,并且只能使用RegExp
对象的Execute
方法创建。当执行正则表达式时,如果子表达式包含在捕获括号中,则可能会导致零个或多个子匹配。SubMatches
集合中的每个项都是正则表达式找到并捕获的字符串。尝试使用
Debug.Print
语句来查看代码中得到的结果: