Question

我遇到了一个vba脚本问题，该脚本在邮件接收时执行。我想将模板转发到第一个地址查找收到的邮件。为此我执行和正则表达式将电子邮件的地址发送到邮件中，阅读html文件（模板）并将其转发到第一封电子邮件。

几分钟后Outlook关闭我不知道为什么......我认为这是一个性能问题。所以我想优化脚本，如果我可以在两次执行之间，我不想两次读取模板。可以将它存储到全局变量中吗？

VBA脚本：

Sub GetEmailAndForward(Item As Outlook.MailItem)

' RegExp
Dim mailRegExp As RegExp

' File
Dim FileTemplate As Integer
Dim FileProperties As Integer

' Properties
Dim splitProperty() As String

' Email
Dim DataLine As String
Dim emails As MatchCollection
Dim email As String
Dim forward As Outlook.MailItem
Dim body As String
Dim forwardText As String

' Path
Dim fileTemplatePath As String
Dim dirPath As String
Dim filePropertyPath As String

dirPath = "C:\OutlookVBA"

Set mailRegExp = New RegExp

With mailRegExp
    .Pattern = "[\_]*([a-z0-9]+(\.|\_*)?)+@([a-z][a-z0-9\-]+(\.|\-*\.))+[a-z]{2,6}"
    .Global = False
    .IgnoreCase = True
End With

' Get the template
fileTemplatePath = dirPath & "\template.html"

' Get the email body to analyse
body = Item.body

' Get the first email found
If mailRegExp.Test(body) Then
    Set emails = mailRegExp.Execute(body)
    If emails.Count > 0 Then
        email = emails.Item(0)

        Set forward = Item.forward

        FileTemplate = FreeFile()
        Open fileTemplatePath For Input As #FileTemplate

        While Not EOF(FileTemplate)
            Line Input #FileTemplate, DataLine
            forwardText = forwardText & DataLine
        Wend

        forward.BodyFormat = olFormatHTML
        forward.HTMLBody = forwardText & forward.HTMLBody

        Close #FileTemplate

        If Not IsEmpty(email) Then
            forward.Recipients.Add email
            forward.subject = "RE:" & Item.subject
            forward.Send
        End If
    End If
End If
End Sub

Answer 1

你可以使用这样的东西 - 该函数只会在第一次调用时从文件中读取，之后将使用存储在静态变量中的文本：

Function GetForWardText(f As String) As String

    Static rv As String '<< valuje is maintained between calls

    If Len(rv) = 0 Then
        rv = CreateObject("scripting.filesystemobject"). _
                  opentextfile(f, 1).readall()
    End If

    ForWardText = rv

End Function

在您的代码中，将其删除：

    FileTemplate = FreeFile()
    Open fileTemplatePath For Input As #FileTemplate

    While Not EOF(FileTemplate)
        Line Input #FileTemplate, DataLine
        forwardText = forwardText & DataLine
    Wend

并替换为：

    forwardText = GetForWardText(fileTemplatePath)

Outlook VBA规则，在内存中加载数据（静态？）

1 个答案: