Question

我编写了一个脚本，其预期行为应该会更改收到的电子邮件的主题行。

这是因为第三方程序监视Outlook文件夹并根据主题行以某种方式将其发布到虚拟文件柜。

我已经编写了下面的代码，所有更改都可以，但主题行不会被更改 - 任何人都可以对此有所了解吗？

Sub AmendSubject(myItem As Outlook.MailItem)

Dim strBranch As String
Dim strPolRef As String
Dim strTo As String

Dim cnn As ADODB.Connection
Dim rs As ADODB.Recordset
Dim rsSQL As String

Dim strSubject As String

Set cnn = New ADODB.Connection

Set rs = New ADODB.Recordset
'Places the Customer Email Address in a string
strTo = myItem.To
strTo = Replace(strTo, "'", "")

cnn.Open "Provider=SQLOLEDB;Data Source=my-srv;Initial Catalog=DB;User ID=xxxx;Password=xyz;"
'SQL Statement
rsSQL = "SELECT TOP 1 [c].[B@] AS [Branch], p.[PolRef@] AS [Ref] FROM [dbo].[ic_yyclient] AS c" & _
" INNER JOIN [dbo].[ic_brpolicy] AS p ON [c].[B@] = [p].[B@] AND [c].[Ref@] = [p].[Ref@]" & _
" LEFT OUTER JOIN [dbo].[ic_BD_ATS1] AS ats1 ON [p].[B@] = [ats1].[B@] AND [p].[PolRef@] = [ats1].[PolRef@]" & _
" WHERE [Ptype] IN ('PC','TW') AND (c.[Email] = '" & strTo & "' OR ats1.[Email] = '" & strTo & "' OR ats1.[Parents_email] = '" & strTo & "') AND [Term_code] IS NULL" & _
" ORDER BY [ats1].[PolRef@] desc"

Debug.Print rsSQL

rs.Open rsSQL, cnn, adOpenForwardOnly

With rs
 While Not .EOF
        strBranch = !Branch
        strPolRef = !Ref
        .MoveNext
 Wend
End With

strSubject = "REF: 0" & strBranch & "-" & strPolRef & "-C<Email To Client>NB Documentation Email"
myItem.Subject = strSubject
myItem.Save

rs.Close

Set rs = Nothing
Set cnn = Nothing

End Sub

VBA - 在收到电子邮件时更改Outlook主题行

0 个答案: