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


0

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

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

0

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

  0

Я думаю, вы пропустили часть 'Outlook/Exchange 2013'. 18 ноя. 152015-11-18 17:18:41

  0

Да, я сделал. Пожалуйста, не уменьшайте меня. У меня есть дети, чтобы кормить. 19 ноя. 152015-11-19 00:48:32

  0

Hahaha :-) Вы знаете, что можете удалить свой ответ? @Delmer 19 ноя. 152015-11-19 07:35:30


1

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

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