Microsoft Access VBA Создать подкаталог подстановочных папок

Question

Я ищу несколько советов по Microsoft Access VBA. В принципе, меня попросили создать кнопку в форме, после нажатия этой кнопки появится окно с запросом имя папки (я могу ввести вручную, затем нажать «ОК»), после чего создаст подпапку в общей папке в Outlook/Exchange 2013.

Любая информация/советы по этому вопросу будут фантастическими. Я пробовал некоторые примеры в Интернете, но мои знания VBA не позволяют мне изменять код для моих нужд.

Answer 1

Используйте команду Shell в VBA. Вы можете выполнять команды DOS для создания папок. https://msdn.microsoft.com/en-us/library/office/gg278437%28v=office.15%29.aspx

Answer 2

Вне всякого сомнения, этот код можно убрать. Он создаст папку «Новый» в папке «Входящие». Вам нужно будет обновить код, чтобы указать правильную папку и запросить новое имя.

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