目标文件夹未正确设置答案

【问题标题】：Destination folder not properly set目标文件夹未正确设置
【发布时间】：2020-05-18 17:51:36
【问题描述】：

我有读取电子邮件类别/电子邮件地址/主题/发件人姓名的代码。然后它在不同的 Excel 表中搜索此信息。如果找到，它会找到目标文件夹以移动已读电子邮件。

问题从这里开始。
在第一个周期中，它会识别目标文件夹并移动电子邮件。在下一封符合条件的电子邮件中，当它尝试分配已识别的文件夹名称时，它要么保留以前的目标文件夹，要么设置为空。

Sub MoveEmail()
Public objOutlook As Object, objnSpace As Object
Public olApp As Outlook.Application
Public olNS As Outlook.Namespace
Public SrcFolder As Outlook.MAPIFolder
Public DestFolder As Outlook.MAPIFolder

Public colStores As Stores
Public oStore As Store
Public objCategories As Categories
Public objCategory As Category

Public objVariant As Variant
Public FolderType As Variant
Public FolderName As String

Set objOutlook = CreateObject("Outlook.Application")
Set objnSpace = objOutlook.GetNamespace("MAPI")
'Set olApp = Outlook.Application
Set olApp = CreateObject("Outlook.Application")
Set olNS = olApp.GetNamespace("MAPI")

'Sets the Mailname equals to what is selected from the dropdown list
MailName = ShMain.cboMailbox.Value -- Get the name of the shared mailbox from a dropdown menu

'Finds mailbox real name
' The name on the ShMain.cboMailbox.Value dropdown list is just a 'friendly' name so the shared mailbox real name is found on the table below using Vlookup
MailRealName = Application.VLookup(MailName, ShRef.Range(RangeTemp), 2, False)
Set SrcFolder = olNS.Folders(MailRealName).Folders("Inbox")

EmailCount = SrcFolder.Items.Count

For EmailCount = SrcFolder.Items.Count To 1 Step -1
    Set objVariant = SrcFolder.Items.Item(EmailCount)
    DoEvents

    If objVariant.UnRead = False Then
        
        On Error Resume Next
        TempEmailAddress1 = objVariant.Sender.GetExchangeUser().PrimarySmtpAddress
        TempEmailAddress2 = objVariant.SenderEmailAddress
        
        If InStr(TempEmailAddress2, "/") <> 0 Then
            TempEmailAddress = TempEmailAddress1
        ElseIf TempEmailAddress1 = "" And TempEmailAddress2 <> "" Then
            TempEmailAddress = TempEmailAddress2
        Else
            TempEmailAddress = TempEmailAddress1
        End If

'this code just makes sure the variable has a valid email since the email couldve been sent within or outside the company
        
        DomainName = Split(TempEmailAddress, "@")
        DomainName = DomainName(UBound(DomainName))
        SenderName = objVariant.SenderName
        EmailSubject = objVariant.Subject
        EmailCategory = objVariant.Categories
        
        'Changes all variables to lower case
        TempEmailAddress = LCase(TempEmailAddress)
        DomainName = LCase(DomainName)
        SenderName = LCase(SenderName)
        EmailSubject = LCase(EmailSubject)
        EmailCategory = LCase(EmailCategory)
        
'Now that we have the basic information, we use them to search them on the 5 different tables on a diff excel sheet called ShRules:
'Table 1: used to find the email's set category and get the subfolder the email needs to be moved to
'Table 2: used to find the email's domain and get the subfolder the email needs to be moved to
'Table 3: used to find the email address and gets the subfolder the email needs to be moved to
'Table 4: used to find the email subject (key words) and gets the subfolder the email needs to be moved to
'Table 3: used to find the email sender name and gets the subfolder the email needs to be moved to

        '*******************************
        'Moves email based on Category
        '*******************************
LastRow = ShRules.Range("A1048576").End(xlUp).Row
        'On Error Resume Next
        x = 3
        Do While x <= LastRow
            If ShRules.Cells(x, 1).Value = ShMain.cboMailbox.Value And EmailCategory = ShRules.Cells(x, 2).Value Then
                FolderType = ShRules.Cells(x, 3).Value
                FolderName = ShRules.Cells(x, 4).Value
'**********
'This is where the Set DestFolder code does not work after the loop does the first cycle
'**********
                Set DestFolder = olNS.Folders(MailRealName).Folders("Inbox").Folders(FolderType).Folders(FolderName)
                Call MoveToFolder
                GoTo LetsContinue
            End If
            x = x + 1
        Loop

        '*****************************************************************
        'Checks to see if it appears on the table for Email's domain name
        '*****************************************************************
        LastRow = ShRules.Range("F1048576").End(xlUp).Row
        'On Error Resume Next
        x = 3
        Do While x <= LastRow
            If ShRules.Cells(x, 6).Value = ShMain.cboMailbox.Value And DomainName = ShRules.Cells(x, 7).Value Then
                FolderType = ShRules.Cells(x, 8).Value
                FolderName = ShRules.Cells(x, 9).Value
'**********
'if it falls under this section - This is where the Set DestFolder code does not work after the loop does the first cycle
'**********
                Set DestFolder = olNS.Folders(MailRealName).Folders("Inbox").Folders(FolderType).Folders(FolderName)
                Call MoveToFolder
                GoTo LetsContinue
            End If
            x = x + 1
        Loop

        '********************************************************************
         'Checks to see if it appears on the table for Email's email address
        '********************************************************************
        LastRow = ShRules.Range("K1048576").End(xlUp).Row
        'On Error Resume Next
        x = 3
        Do While x <= LastRow
            If ShRules.Cells(x, 11).Value = ShMain.cboMailbox.Value And TempEmailAddress = ShRules.Cells(x, 12).Value Then
                FolderType = ShRules.Cells(x, 13).Value
                FolderName = ShRules.Cells(x, 14).Value
'**********
'if it falls under this section - This is where the Set DestFolder code does not work after the loop does the first cycle                
'**********
                Set DestFolder = olNS.Folders(MailRealName).Folders("Inbox").Folders(FolderType).Folders(FolderName)
                Call MoveToFolder
                GoTo LetsContinue
            End If
            x = x + 1
        Loop

        '************************************************************
        'Checks to see if it appears on the table for Email Subjects
        '************************************************************
        LastRow = ShRules.Range("P1048576").End(xlUp).Row
        'On Error Resume Next
        x = 3
        Do While x <= LastRow
            If ShRules.Cells(x, 16).Value = ShMain.cboMailbox.Value And InStr(EmailSubject, ShRules.Cells(x, 17).Value) <> 0 Then
                FolderType = ShRules.Cells(x, 18).Value
                FolderName = ShRules.Cells(x, 19).Value
'**********
'if it falls under this section - This is where the Set DestFolder code does not work after the loop does the first cycle
'********** 
                Set DestFolder = olNS.Folders(MailRealName).Folders("Inbox").Folders(FolderType).Folders(FolderName)
                Call MoveToFolder
                GoTo LetsContinue
            End If
            x = x + 1
        Loop
        
        '***************************************************************
        'Checks to see if it appears on the table for Email sender name
        '***************************************************************
        LastRow = ShRules.Range("U1048576").End(xlUp).Row
        'On Error Resume Next
        x = 3
        Do While x <= LastRow
            If ShRules.Cells(x, 21).Value = ShMain.cboMailbox.Value And ShRules.Cells(x, 22).Value = SenderName Then
                FolderType = ShRules.Cells(x, 23).Value
                FolderName = ShRules.Cells(x, 24).Value
'**********
'if it falls under this section - This is where the Set DestFolder code does not work after the loop does the first cycle
'**********
                Set DestFolder = olNS.Folders(MailRealName).Folders("Inbox").Folders(FolderType).Folders(FolderName)
                Call MoveToFolder
                GoTo LetsContinue
            End If
            x = x + 1
        Loop
    End If

'    Call ResetVals
LetsContinue:
    'x = x + 1
    Call ResetVals
Next

我尝试添加Set DestFolder = Nothing，但没有帮助。

我注意到，在我收到此错误后，如果我再次运行代码，即使第一个循环也不会分配 DestFolder。只有在我关闭 Outlook 后才能再次使用。

【问题讨论】：

附注，但您正在混合早期绑定和后期绑定，而且您有两个 Outlook 实例 (Set objOutlook = CreateObject("Outlook.Application")) 和 (Set olApp = CreateObject("Outlook.Application"))。最好保持一致。
注释掉On Error Resume Next 看看是否有错误，或者至少通过On Error Goto 0 重置将其范围限制在最低限度。此外，您在一个过程中做的太多 - 尝试将部分代码分解为单独的子/函数，以便更容易理解。
在尝试查找目的地之前添加Set Destfolder = Nothing 应该会有所帮助，否则如果没有合适的匹配项，您仍然拥有以前的文件夹。除非你在 ResetVals 中这样做（你使用的是一堆全局变量吗？）
@BigBen , ，谢谢其中一个是评论，我刚刚删除了它
@蒂姆·威廉姆斯。我之前添加了“Set DestFolder = Nothing”，就像你建议的那样，我一直遇到同样的问题：在这行代码中成功找到了变量`Set DestFolder = olNS.Folders(MailRealName).Folders("Inbox")。 Folders(FolderType).Folders(FolderName)` 找到“FolderName”变量并将其加载到变量中，但是当下一个时间线设置 DestFolder 时，它返回空而不是 Set DestFolder =“无论 Outlook 子文件夹名称”子文件夹路径也是正确的

标签： excel vba outlook

【解决方案1】：

首先，不需要在代码中创建两个 Outlook Application 类的实例：

Set objOutlook = CreateObject("Outlook.Application")
Set objnSpace = objOutlook.GetNamespace("MAPI")
'Set olApp = Outlook.Application
Set olApp = CreateObject("Outlook.Application")
Set olNS = olApp.GetNamespace("MAPI")

所以，只需删除多余的代码行：

Set olApp = CreateObject("Outlook.Application")
Set olNS = olApp.GetNamespace("MAPI")

然后我建议在调试器下运行代码以找到它失败的行。请参阅Getting started with VBA in Office 了解更多信息。

Set DestFolder = olNS.Folders(MailRealName).Folders("Inbox").Folders(FolderType).Folders(FolderName)

一行代码包含大量的属性和方法调用。目前尚不清楚究竟哪个调用失败了。因此，我建议打破属性和方法调用链并将它们声明在不同的行中。

【讨论】：

嗨@EugeneAstafiev 感谢您的反馈。我删除了额外的代码行。我运行了调试器，但仍然遇到同样的问题。在第一个循环之后并成功移动了第一封电子邮件；当第二个循环识别出要移动的新电子邮件（进入不同的文件夹）时，它没有将正确的文件夹名称分配给 DestFolder 变量（在第二次循环运行时），它保持为空。我不确定错误到底在哪里
> Set DestFolder = olNS.Folders(MailRealName).Folders("Inbox").Folders(FolderType).Folders(FolderName)
在单独的行上声明每个属性或方法调用，这样您就可以找到确切失败的方法。
嗨@EugeneAstafiev 我听从了你的建议，这就是我发现的。 Set DestFolder = olNS.Folders(MailRealName).Folders("Inbox").Folders(FolderType).Folders(FolderName) 我创建了 3 个新变量 Set DestFolder1 = olNS.Folders(MailRealName) then Set DestFolder2 = olNS.Folders(MailRealName).Folders("Inbox").Folders(FolderType) and Set DestFolder3 = olNS.Folders(MailRealName).Folders("Inbox").Folders(FolderType).Folders(FolderName) 前 2 个变量运行良好，它们相应地进行了更新。最后一个不起作用，它将变量设置为“Nothing”所有var类型都是正确的。
我确实想指出一些有趣的事情。如果我第一次运行宏...如前所述，第一个循环起作用并将电子邮件移动到正确的电子邮件但是...如果我当场停止宏.....然后尝试运行它再次，DestFolder2 和 DestFolder3 变量现在保持为空。我需要完全关闭 Outlook，再次重新打开它...运行宏以使其再次工作...这很奇怪，我不明白为什么我需要关闭 Outlook 应用程序并重新打开它才能要在 Excel 工作表上的宏上正确捕获的变量。

【解决方案2】：

所以经过多次故障排除后，我发现了问题所在。似乎您可以下降到多少级子文件夹是有限制的。我的级别是“邮箱名称”--> 收件箱--> 文件夹名称--> “所需的子文件夹”。有 4 个级别，当我删除一个级别时它起作用了：“邮箱名称”-> 文件夹名称 --->“所需的子文件夹”

【讨论】：