Question

我在下面有一个查询，我正在尝试修改收到的电子邮件的主题行，然后将其移动到邮箱（不是收件箱）中的文件夹。

我需要这样做，因为外部程序会监视此文件夹并相应地记录电子邮件。

我可以找到很多关于如何在外部系统地移动项目，或者移动收件箱子文件夹中的对象而不是主要＆＃39;邮箱内的文件夹的信息。

任何人都可以为我照亮任何光明，请记住这是一个＆＃39; Run As Script＆＃39;当邮件进来时。

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 objNS As Outlook.NameSpace
'Set objNS = Application.GetNamespace("MAPI")

'Set myInbox = objNS.GetDefaultFolder(olFolderInbox)

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=xxx;Initial Catalog=xxxx;User ID=xxxxx;Password=xxx;"
'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.[p_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.Display
myItem.Subject = strSubject
myItem.Save

rs.Close

'myItem.Move fldrOAtt

Set rs = Nothing
Set cnn = Nothing

End Sub

Answer 1

如果文件夹与收件箱位于同一级别，请检索其父级，然后向下一级：

set subfolder = myInbox.Parent.Folders.Item("the folder name")

主题行更改后VBA移动MailItem

1 个答案: