使用access vba从Outlook中提取电子邮件，而不是仅处理一个文件夹

我需要将Outlook辅助帐户中的电子邮件提取到access中，但除了需要提取的文件夹外，它在我的所有文件夹中都可以正常工作。我比较了两个辅助帐户文件夹的权限，它们是相同的！我已经检查了信任并取消了下载

Dim objApp As Outlook.Application
Dim objNS As Outlook.NameSpace
Dim colFolders As Outlook.Folders
Dim objFolder As Outlook.MAPIFolder
Dim objParentFolder As Outlook.MAPIFolder
Dim objMailItem As Outlook.MailItem
Dim strSQL As String
Dim strBody As String
Dim strSubject As String
Const strDoubleQuote As String = """"
Dim strFolderPath As String
Dim i As Byte
On Error GoTo Form_Load_Error

Set objApp = New Outlook.Application
Set objNS = objApp.GetNamespace("MAPI")

For i = 1 To objNS.Folders.Count
    Set objParentFolder = objNS.Folders(i)
    
    '';I use OutlookFolderNames to locate the folder in the user’s Outlook
    Set objFolder = OutlookFolderNames(objParentFolder, "Inbox")
    
    ' **Note that the objFolder shows that OutlookFolderNames found the "Inbox" as valid. I can change Inbox for any other folder and it works fine**
    If Not objFolder Is Nothing Then
        'Once the folder is located exit For
        Exit For
    End If
Next i

If Not objFolder Is Nothing Then
    For Each objMailItem In objFolder.Items
        With objMailItem

Set objFolder = Nothing
Set objNS = Nothing
Set objApp = Nothing
            
ExitProcedure:
     On Error GoTo 0
     Exit Sub
            
Form_Load_Error:
     MsgBox "Error " & Err.Number & " (" & Err.Description & ") in procedure Form_Load of VBA Document Form_frmImportEmails """

---

我想发布函数，但我得到一个错误，说有太多的代码

获取objFolder的函数正在从另一个辅助文件夹（objParentFolder）中拾取收件箱，即使在实际的Outlook屏幕中看不到收件箱。每个操作都必须有一个收件箱，这必须是默认操作。我所需要做的就是检查objParentFolder=是否是正确的辅助文件夹，然后检查与之关联的“收件箱”。当我打开并查看outlook本身时，没有其他收件箱出现在第二个收件箱中，这让我感到震惊。它们是隐藏的

---

谢谢你的时间，皮特

我确实看到过比这里显示的代码多得多的帖子。您的函数中有多少代码？正如我在您的问题中编辑的那样，使用适当的缩进更容易准备好代码。错误处理程序代码不应在循环中。如果，例如，使用块，要关闭的行在哪里？错误处理程序不正确。这是否回答了您的问题？