Question

启动Outlook时，我需要我的VBA在辅助电子邮件帐户中的特定文件夹上运行，以查看在我的计算机关闭且Outlook VBA未运行期间是否有人在其中移动了电子邮件。如果在我的计算机处于“脱机”状态时，带有附件的电子邮件已移到该文件夹中，我希望代码自动保存附件。我还有其他代码可以在Outlook运行时监视文件夹并保存附件。它还在电子邮件中添加了一条注释“文件已保存到C：\ Temp \ TEST \”。当Outlook启动时，我希望脚本扫描文件夹中的电子邮件，以查找没有文本“文件已保存到C：\ Temp \ TEST \”的电子邮件，然后保存这些附件。

我知道脚本的保存/添加文本部分有效，但是，在此行上出现错误“对象变量或未设置块”：

If InStr(1, LCase(ItemCrnt.Body), LCase("The file(s) were saved to")) > 0 Then

我无法弄清楚我的问题是什么，尽管我怀疑这一定与我定义变量的方式有关。感谢提供的任何帮助！

Private Sub Application_Startup()

Dim ns As Outlook.NameSpace
Dim olAccount As Outlook.Recipient
Dim olInbox As Outlook.Folder
Dim ItemCrnt As Object
Dim strFile As String
Dim strFolderpath As String

Set ns = Application.GetNamespace("MAPI")
Set olAccount = ns.CreateRecipient("xyz@mycompany.com")

olAccount.Resolve

Set olInbox = ns.GetSharedDefaultFolder(WLAccount, olFolderInbox)
Set ItemCrnt = olInbox.Folders("My Folder").Items

' First check the folders and make sure that any exisiting emails in the 
folders have already had attachments saved to the strFolderpath

' Get the path to the folder
strFolderpath = "C:\Temp\TEST\"

' Check each selected item for attachments. If attachments exist,
' save them to the strFolderPath folder and add a note to the message with 
the file path.

With ItemCrnt

' This code only saves attachments from mail items.
 'If .Class = olMail Then
'Check if the attachments have already been saved
    If InStr(1, LCase(ItemCrnt.Body), LCase("The file(s) were saved to")) > 0 Then
...code to save attachments and add text to body of message goes here...
    End If
  End If
End With
End Sub

Answer 1

Option Explicit ' Consider this mandatory
' Tools | Options | Editor tab
' Require Variable Declaration
' If desperate declare as Variant

Private Sub Application_Startup()

    Dim ns As namespace
    Dim myAccount As Recipient
    Dim myInbox As folder
    
    Dim fldrItems As Items
    Dim ItemCrnt As Object
    
    Dim i As Long
    
    Set ns = GetNamespace("MAPI")
    Set myAccount = ns.CreateRecipient("xyz@mycompany.com")
    
    ' Names can be resolved, anything in address format is "accepted" as resolved.
    ' myAccount.Resolve
    
    ' WLAccount     ' <-- Option Explicit
    'Set olInbox = ns.GetSharedDefaultFolder(WLAccount, olFolderInbox)
    
    Set myInbox = ns.GetSharedDefaultFolder(myAccount, olFolderInbox)
    
    Set fldrItems = myInbox.folders("My Folder").Items
    
    ' Check each item.
    For i = 1 To fldrItems.Count
    
        ' process mail items only.
        If fldrItems(i).Class = olMail Then
        
            Set ItemCrnt = fldrItems(i)
    
            With ItemCrnt
                Debug.Print ItemCrnt.subject
            End With
            
        End If
        
    Next

End Sub

如何使用VBA在电子邮件正文中保存不带特定文本的电子邮件附件？

1 个答案: