При ошибке Возобновить Далее Не работает / Ошибка создания папки 440 - PullRequest
0 голосов
/ 18 апреля 2019

Шаг 1: Я хочу создать папку, и если она не работает (потому что она может уже существовать), я хочу, чтобы она просто проигнорировала и продолжила:

    Sub MakeFolder()

    'declare variables
    Dim outlookApp As Outlook.Application
    Dim NS As Outlook.NameSpace

    'set up folder objects    
    Set outlookApp = New Outlook.Application
    Set outlookApp = New Outlook.Application
    Set NS = outlookApp.GetNamespace("MAPI")
    Set objOwner = NS.CreateRecipient("email@host.com")
    objOwner.Resolve
    Set outlookInbox = NS.GetSharedDefaultFolder(objOwner, olFolderInbox)

    'make a folder, maybe
    Dim newFolder 
    On Error Resume Next
    Set newFolder = outlookInbox.Folders.Add("myNewFolder")
    On Error GoTo -1
    On Error GoTo 0
    End Sub

но я все еще получаю ошибку:

enter image description here

как я могу получить этот runnign?Если папка не существует, она работает гладко и создает ее.

Step2: У меня есть список папок (около 60), которые могут со временем меняться.из-за этого я хотел бы запустить скрипт проверки новых папок и затем создать их:

     For Each fol In folders
        On Error Resume Next
        Set newFolder = outlookInbox.Folders.Add(fol)
        If Err.Number <> 0 Then
            On Error GoTo -1
        Else:
            Debug.Print fol & " created "
        End If
        On Error GoTo 0
    Next ID

то же самое здесь, outlookInbox.Folders.Add() выдает ошибки независимо от возврата следующего, если не можетсоздать эту папку.что я могу сделать?

Редактировать

[см. 1-й комментарий для решения]

1 Ответ

0 голосов
/ 19 апреля 2019

Теперь, когда вы исправили свою IDE, вы можете использовать следующий код

Option Explicit
Public Sub Example()
    Dim olNs As Outlook.NameSpace
    Set olNs = Application.GetNamespace("MAPI")

    Dim Inbox  As Outlook.Folder
    Set Inbox = olNs.GetDefaultFolder(olFolderInbox)

    Dim SubFolder As Outlook.Folder

    '// SubFolder Name
    Dim FolderName As String
    FolderName = "myNewFolder"

    '// Check if folder exist else create one
    If FolderExists(Inbox, FolderName) = True Then
        Debug.Print "Folder Exists"
        Set SubFolder = Inbox.Folders(FolderName)
    Else
        Set SubFolder = Inbox.Folders.Add(FolderName)
    End If

End Sub


'//  Function - Check folder Exist
Private Function FolderExists(Inbox As Folder, FolderName As String)
    Dim Sub_Folder As MAPIFolder

    On Error GoTo Exit_Err
    Set Sub_Folder = Inbox.Folders(FolderName)

    FolderExists = True
        Exit Function

Exit_Err:
    FolderExists = False

End Function
Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...