Question

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

 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

为什么？我该怎么做才能解决问题？

Answer 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
  subFolder = myFolder.Folders.Add("Close")
End If

Answer 2

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

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

Sub DemoGetCreateFldr显示了如何使用功能GetCreateFldr来达到我认为您想要的效果。

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

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

对于文件夹“ EID2”和“ EID3”，我没有保存与您的代码匹配的引用。

如果存在文件夹“关闭”，“ 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

Answer 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

Answer 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

Answer 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

检查Outlook文件夹是否存在；如果没有创建

5 个答案: