outlook check if dir and sub dir exist

outlook check if dir and sub dir exist

Postby sal21 » 11 Sep 2012, 20:23

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 :grin:

Note:
See the dir HANS is a dir of my prefered friend on line :evilgrin: :clapping: :fanfare:
You do not have the required permissions to view the files attached to this post.
Post=81892
User avatar
sal21
SilverLounger
 
Posts: 1886
Joined: 26 Apr 2010, 17:36

Re: outloo check if dir and sub dir exisst

Postby HansV » 11 Sep 2012, 20:26

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?
Regards,
Hans
Post=81894
User avatar
HansV
Clever Clogs
 
Posts: 33277
Joined: 16 Jan 2010, 00:14
Location: Leiden, The Netherlands

Re: outloo check if dir and sub dir exisst

Postby sal21 » 11 Sep 2012, 20:45

HansV wrote: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% :grin:
Post=81897
User avatar
sal21
SilverLounger
 
Posts: 1886
Joined: 26 Apr 2010, 17:36

Re: outlook check if dir and sub dir exisst

Postby HansV » 11 Sep 2012, 20:58

I have moved this thread to the VB/VBA forum.
Regards,
Hans
Post=81898
User avatar
HansV
Clever Clogs
 
Posts: 33277
Joined: 16 Jan 2010, 00:14
Location: Leiden, The Netherlands

Re: outlook check if dir and sub dir exisst

Postby HansV » 11 Sep 2012, 21:17

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.
Regards,
Hans
Post=81899
User avatar
HansV
Clever Clogs
 
Posts: 33277
Joined: 16 Jan 2010, 00:14
Location: Leiden, The Netherlands

Re: outlook check if dir and sub dir exisst

Postby sal21 » 12 Sep 2012, 08:04

HansV wrote: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! :grin: but as usual you read in my mind!!!!!! :laugh: :laugh: :laugh:
Post=81925
User avatar
sal21
SilverLounger
 
Posts: 1886
Joined: 26 Apr 2010, 17:36


Return to VB/VBA/.Net

Who is online

Users browsing this forum: CCBot [Bot] and 0 guests