Microsoft Access VBA 创建公共文件夹子文件夹答案

【问题标题】：Microsoft Access VBA Create Public-Folder SubfolderMicrosoft Access VBA 创建公共文件夹子文件夹
【发布时间】：2016-02-20 01:19:02
【问题描述】：

我正在寻找有关 Microsoft Access VBA 的一些建议 - 基本上，我被要求在表单上创建一个按钮，单击此按钮后，它将显示一个询问文件夹名称的框（我可以手动输入，然后单击“确定”），然后将在 Outlook/Exchange 2013 的公用文件夹中创建一个子文件夹。

任何有关这方面的信息/建议都会很棒。我在 Internet 上尝试了一些示例，但我的 VBA 知识不允许我根据需要修改代码。

【问题讨论】：

标签： ms-access outlook vba exchange-server

【解决方案1】：

毫无疑问，这段代码是可以整理的。它将在收件箱中创建一个名为“New One”的文件夹。您需要更新代码以指向正确的文件夹并询问新名称。

Sub CreateFolder()

        Dim oOutlook As Object          'Outlook.Application
        Dim nNameSpace As Object        'Outlook.Namespace
        Dim oFolder As Object

        Dim sFolder As String
        sFolder = "Mailbox - Bill Gates\Inbox"

        Set oOutlook = CreateObject("Outlook.Application")
        Set nNameSpace = oOutlook.GetNameSpace("MAPI")

        Set oFolder = GetFolderPath(sFolder)
        oFolder.Folders.Add "New One" 'Add the 'New One' folder to the Inbox.

    End Sub

    '----------------------------------------------------------------------------------
    ' Procedure : GetFolderPath
    ' Author    : Diane Poremsky
    ' Date      : 09/06/2015
    ' Original  : http://www.slipstick.com/developer/working-vba-nondefault-outlook-folders/
    ' Purpose   :
    '-----------------------------------------------------------------------------------
    Function GetFolderPath(ByVal FolderPath As String) As Object 'Outlook.Folder

        Dim oOutlook As Object          'Outlook.Application
        Dim nNameSpace As Object        'Outlook.Namespace

        Dim oFolder As Object 'Outlook.Folder
        Dim FoldersArray As Variant
        Dim i As Integer

        On Error GoTo GetFolderPath_Error

        Set oOutlook = CreateObject("Outlook.Application")

        If Left(FolderPath, 2) = "\\" Then
            FolderPath = Right(FolderPath, Len(FolderPath) - 2)
        End If
        FoldersArray = Split(FolderPath, "\")
        Set oFolder = oOutlook.Session.Folders.Item(FoldersArray(0))
        If Not oFolder Is Nothing Then
            For i = 1 To UBound(FoldersArray, 1)
                Dim SubFolders As Object
                Set SubFolders = oFolder.Folders
                Set oFolder = SubFolders.Item(FoldersArray(i))
                If oFolder Is Nothing Then
                    Set GetFolderPath = Nothing
                End If
            Next
        End If
        Set GetFolderPath = oFolder
        Exit Function

    GetFolderPath_Error:
        Set GetFolderPath = Nothing
        Exit Function
    End Function

【讨论】：

【解决方案2】：

在 VBA 中使用 Shell 命令。您可以执行 DOS 命令来创建文件夹。 https://msdn.microsoft.com/en-us/library/office/gg278437%28v=office.15%29.aspx

【讨论】：

我想你错过了Outlook/Exchange 2013 部分。
是的，我做到了。请不要对我投反对票。我有孩子要喂。
哈哈哈 :-) 你知道你可以删除你的答案吗？ @Delmer