检查outlook文件夹是否存在；如果不创建它答案

【问题标题】：Check if an outlook folder exists; if not create it检查outlook文件夹是否存在；如果不创建它
【发布时间】：2019-04-21 06:24:26
【问题描述】：

我正在尝试检查文件夹是否存在；如果没有，则创建它。下面只是抛出一个运行时错误。

 Sub AddClose()
 Dim myNameSpace As Outlook.NameSpace
 Dim myFolder As Outlook.Folder
 Dim myNewFolder As Outlook.Folder
 Set myNameSpace = Application.GetNamespace("MAPI")
 Set myFolder = myNameSpace.GetDefaultFolder(olFolderInbox)

            If myFolder.Folders("Close") = 0 Then
                myFolder.Folders.Add("Close").Folders.Add ("EID1")
                myFolder.Folders("Close").Folders.Add ("EID2")
                myFolder.Folders("Close").Folders.Add ("EID3")

            End If
End Sub

但是，如果文件夹存在，那么下面的工作...

If myFolder.Folders("Close") > 0 Then
    MsgBox "Yay!"            
End If

为什么？我能做些什么来纠正这个问题？

【问题讨论】：

您可以添加“on error goto”来处理不存在的文件夹。 Folders() 方法要么返回 Folder 对象，要么引发错误。见related post。

标签： vba outlook outlook-2016

【解决方案1】：

首先，您将myFolder.Folders("Close") 调用的结果（应该返回MAPIFolder 对象）与整数(0) 进行比较。您需要使用Is Nothing 或Is not Nothing 运算符。

其次，如果找不到具有给定名称的文件夹，MAPIFolder.Folders.Item() 会引发异常。您需要捕获该异常（就像在 VBA 中一样丑陋）并检查 Err.Number 值或检查返回对象是否已设置：

On Error Resume Next
set subFolder = myFolder.Folders.Item("Close")
if subFolder Is Nothing Then
  set subFolder = myFolder.Folders.Add("Close")
End If

【讨论】：

【解决方案2】：

我不明白：If myFolder.Folders("Close") = 0 Then。 myFolder.Folders("Close") 是一个文件夹，我不会想到将它与零进行比较。您是否引用了解释此功能的站点，因为我想了解它？

如果文件夹不经常存在而无法编写函数，我希望创建一个文件夹。我的函数没有满足您要求的理想参数，但它可以工作。我将其作为经过测试的代码提供，可以满足您的需求，或者作为您自己代码的灵感来源。

子DemoGetCreateFldr展示了如何使用GetCreateFldr函数来达到我相信你寻求的效果。

我不使用GetDefaultFolder，因为在我的系统上，它返回对我不使用的商店的引用。 “Outlook 数据文件”是 Outlook 的默认存储，但向导为我的两个电子邮件地址中的每一个创建了一个单独的存储。在Set Store = Session.Folders("Outlook Data File") 中，将“Outlook 数据文件”替换为包含要为其创建子文件夹的收件箱的商店的名称。

GetCreateFldr 的第一次调用创建文件夹“Close”，如果它不存在，然后创建文件夹“EID1”。我保存对文件夹的引用，并使用 Debug.Print 来演示它返回正确的引用。

对于文件夹“EID2”和“EID3”，我不保存与您的代码匹配的参考。

如果文件夹“Close”、“EID1”、“EID2”和“EID3”存在，GetCreateFldr 不会尝试创建它们，尽管它仍会返回一个引用。

希望这会有所帮助。

Sub DemoGetCreateFldr()

  Dim FldrEID1 As Folder
  Dim FldrNameFull(1 To 3) As String
  Dim Store As Folder

  Set Store = Session.Folders("Outlook Data File")

  FldrNameFull(1) = "Inbox"
  FldrNameFull(2) = "Close"

  FldrNameFull(3) = "EID1"
  Set FldrEID1 = GetCreateFldr(Store, FldrNameFull)
  Debug.Print FldrEID1.Parent.Parent.Parent.Name & "|" & _
              FldrEID1.Parent.Parent.Name & "|" & _
              FldrEID1.Parent.Name & "|" & _
              FldrEID1.Name

  FldrNameFull(3) = "EID2"
  Call GetCreateFldr(Store, FldrNameFull)

  FldrNameFull(3) = "EID3"
  Call GetCreateFldr(Store, FldrNameFull)

End Sub
Public Function GetCreateFldr(ByRef Store As Folder, _
                              ByRef FldrNameFull() As String) As Folder

  ' * Store identifies the store, which must exist, in which the folder is
  '   wanted.
  ' * FldrNameFull identifies a folder which is or is wanted within Store.
  '   Find the folder if it exists otherwise create it. Either way, return
  '   a reference to it.

  ' * If LB is the lower bound of FldrNameFull:
  '     * FldrNameFull(LB) is the name of a folder that is wanted within Store.
  '     * FldrNameFull(LB+1) is the name of a folder that is wanted within
  '       FldrNameFull(LB).
  '     * FldrNameFull(LB+2) is the name of a folder that is wanted within
  '       FldrNameFull(LB+1).
  '     * And so on until the full name of the wanted folder is specified.

  ' 17Oct16  Date coded not recorded but must be before this date

  Dim FldrChld As Folder
  Dim FldrCrnt As Folder
  Dim ChildExists As Boolean
  Dim InxC As Long
  Dim InxFN As Long

  Set FldrCrnt = Store

  For InxFN = LBound(FldrNameFull) To UBound(FldrNameFull)
    ChildExists = True
    ' Is FldrNameFull(InxFN) a child of FldrCrnt?
    On Error Resume Next
    Set FldrChld = Nothing   ' Ensure value is Nothing if following statement fails
    Set FldrChld = FldrCrnt.Folders(FldrNameFull(InxFN))
    On Error GoTo 0
    If FldrChld Is Nothing Then
      ' Child does not exist
      ChildExists = False
      Exit For
    End If
    Set FldrCrnt = FldrChld
  Next

  If ChildExists Then
    ' Folder already exists
  Else
    ' Folder does not exist. Create it and any children
    Set FldrCrnt = FldrCrnt.Folders.Add(FldrNameFull(InxFN))
    For InxFN = InxFN + 1 To UBound(FldrNameFull)
      Set FldrCrnt = FldrCrnt.Folders.Add(FldrNameFull(InxFN))
    Next
  End If

  Set GetCreateFldr = FldrCrnt

End Function

【讨论】：

【解决方案3】：

对于出错的用户来说，这不是一个好的编码习惯。
我建议您遍历这些文件夹。
然后，如果找不到某个名称，请创建它。
下面的代码是我使用的宏的一部分。
它会在收件箱下查找“重复”。
它故意不递归地执行此操作。

Sub createDuplicatesFolder()
  Dim folderObj, rootfolderObj, newfolderObj As Outlook.folder
  Dim NameSpaceObj As Outlook.NameSpace

  duplicatefolder = False
  For Each folderObj In Application.Session.Folders
    If folderObj.Name = "Duplicates" Then duplicatefolder = True
    Next
  If duplicatefolder = False Then
     Set rootfolderObj = NameSpaceObj.GetDefaultFolder(olFolderInbox)
     Set newfolderObj = rootfolderObj.Folders.Add("Duplicates")
End Sub

【讨论】：

【解决方案4】：

缓慢的方式。取决于文件夹的数量。

Sub checkFolder()

    Dim folderObj As folder
    Dim rootfolderObj As folder
    Dim newfolderObj As folder
    
    Dim checkFolderName As String
        
    ' Check and add in the same location
    Set rootfolderObj = Session.GetDefaultFolder(olFolderInbox)
    
    ' Check and add the same folder name
    checkFolderName = "checkedFolder"
    
    For Each folderObj In rootfolderObj.folders
        If folderObj.name = checkFolderName Then
            Set newfolderObj = rootfolderObj.folders(checkFolderName)
            
            'Reduces the search time, if the folder exists
            Exit For
            
        End If
    Next
    
    If newfolderObj Is Nothing Then
        Set newfolderObj = rootfolderObj.folders.add(checkFolderName)
    End If
    
    Debug.Print newfolderObj.name
    
End Sub

【讨论】：

【解决方案5】：

一种快速的方法。添加而不检查现有文件夹。

Sub addFolder_OnErrorResumeNext()

    Dim rootFolder As folder
    Dim addFolder As folder
    
    Dim addFolderName As String
    
    Set rootFolder = Session.GetDefaultFolder(olFolderInbox)
    addFolderName = "addFolder"
    
    On Error Resume Next
    ' Bypass expected error if folder exists
    Set addFolder = rootFolder.folders.add(addFolderName)
    ' Return to normal error handling for unexpected errors
    ' Consider mandatory after On Error Resume Next
    On Error GoTo 0
    
    ' In other cases the expected error should be handled.
    ' For this case it can be ignored.
    Set addFolder = rootFolder.folders(addFolderName)
    
    Debug.Print addFolder.name
    
End Sub

【讨论】：