outlook check if dir and sub dir exist

[sal21]

Based the image attached is possible to check if in Cartelle Pesonali exists a dir SERVIZIO and our sub dir ASS if not create dir and subdir here the root:

Cartelle personali\SERVIZIO\ASS\

In my case the two dir not exists

Note:
See the dir HANS is a dir of my prefered friend on line

[HansV]

I assume you want VBA code. Do you want to run the code from within Outlook or from within another Office application such as Excel?

[sal21]

I assume you want VBA code. Do you want to run the code from within Outlook or from within another Office application such as Excel?

Such as Excel, NATURALLY! i know well 60%

[HansV]

I have moved this thread to the VB/VBA forum.

[HansV]

Here is a procedure you can use:

Code: Select all

Sub CheckAndCreateFolders(FolderPath As String)
    Dim olApp As Object
    Dim olNsp As Object
    Dim olFld As Object
    Dim olSbf As Object
    Dim arrParts() As String
    Dim i As Long
    Dim blnStart As Boolean
    On Error Resume Next
    Set olApp = GetObject(Class:="Outlook.Application")
    If olApp Is Nothing Then
        Set olApp = CreateObject(Class:="Outlook.Application")
        If olApp Is Nothing Then
            MsgBox "Can't start Outlook", vbExclamation
            Exit Sub
        End If
        blnStart = True
    End If
    Set olNsp = olApp.GetNameSpace("MAPI")
    Set olFld = olNsp.GetDefaultFolder(6).Parent ' 6 = olFolderInbox
    arrParts = Split(FolderPath, "\")
    For i = 0 To UBound(arrParts)
        On Error Resume Next
        Set olSbf = olFld.Folders(arrParts(i))
        On Error GoTo ErrHandler
        If olSbf Is Nothing Then
            Set olSbf = olFld.Folders.Add(arrParts(i))
            If olSbf Is Nothing Then
                MsgBox "Can't create folder " & arrParts(i), vbExclamation
                GoTo ExitHandler
            End If
        End If
        Set olFld = olSbf
        Set olSbf = Nothing
    Next i
ExitHandler:
    On Error Resume Next
    If blnStart Then
        olApp.Quit
    End If
    Exit Sub
ErrHandler:
    MsgBox Err.Description, vbExclamation
    Resume ExitHandler
End Sub

Call it like this:

Code: Select all

    CheckAndCreateFolders "SERVIZIO\ASS"

The code uses late binding; you do *not* need to set a reference to the Microsoft Outlook n.0 Object Library, so it should work in all versions of Office.

[sal21]

Here is a procedure you can use:

Code: Select all

Sub CheckAndCreateFolders(FolderPath As String)
    Dim olApp As Object
    Dim olNsp As Object
    Dim olFld As Object
    Dim olSbf As Object
    Dim arrParts() As String
    Dim i As Long
    Dim blnStart As Boolean
    On Error Resume Next
    Set olApp = GetObject(Class:="Outlook.Application")
    If olApp Is Nothing Then
        Set olApp = CreateObject(Class:="Outlook.Application")
        If olApp Is Nothing Then
            MsgBox "Can't start Outlook", vbExclamation
            Exit Sub
        End If
        blnStart = True
    End If
    Set olNsp = olApp.GetNameSpace("MAPI")
    Set olFld = olNsp.GetDefaultFolder(6).Parent ' 6 = olFolderInbox
    arrParts = Split(FolderPath, "\")
    For i = 0 To UBound(arrParts)
        On Error Resume Next
        Set olSbf = olFld.Folders(arrParts(i))
        On Error GoTo ErrHandler
        If olSbf Is Nothing Then
            Set olSbf = olFld.Folders.Add(arrParts(i))
            If olSbf Is Nothing Then
                MsgBox "Can't create folder " & arrParts(i), vbExclamation
                GoTo ExitHandler
            End If
        End If
        Set olFld = olSbf
        Set olSbf = Nothing
    Next i
ExitHandler:
    On Error Resume Next
    If blnStart Then
        olApp.Quit
    End If
    Exit Sub
ErrHandler:
    MsgBox Err.Description, vbExclamation
    Resume ExitHandler
End Sub

Call it like this:

Code: Select all

    CheckAndCreateFolders "SERVIZIO\ASS"

The code uses late binding; you do *not* need to set a reference to the Microsoft Outlook n.0 Object Library, so it should work in all versions of Office.

i cannot test the code today.

note:
Based the "late binding" if you dont post this solution, naturally i repost to have tath! but as usual you read in my mind!!!!!!