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
outlook check if dir and sub dir exist
-
- PlatinumLounger
- Posts: 4362
- Joined: 26 Apr 2010, 17:36
outlook check if dir and sub dir exist
You do not have the required permissions to view the files attached to this post.
-
- Administrator
- Posts: 78534
- Joined: 16 Jan 2010, 00:14
- Status: Microsoft MVP
- Location: Wageningen, The Netherlands
Re: outloo check if dir and sub dir exisst
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?
Best wishes,
Hans
Hans
-
- PlatinumLounger
- Posts: 4362
- Joined: 26 Apr 2010, 17:36
Re: outloo check if dir and sub dir exisst
Such as Excel, NATURALLY! i know well 60%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?
-
- Administrator
- Posts: 78534
- Joined: 16 Jan 2010, 00:14
- Status: Microsoft MVP
- Location: Wageningen, The Netherlands
Re: outlook check if dir and sub dir exisst
I have moved this thread to the VB/VBA forum.
Best wishes,
Hans
Hans
-
- Administrator
- Posts: 78534
- Joined: 16 Jan 2010, 00:14
- Status: Microsoft MVP
- Location: Wageningen, The Netherlands
Re: outlook check if dir and sub dir exisst
Here is a procedure you can use:
Call it like this:
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.
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
Code: Select all
CheckAndCreateFolders "SERVIZIO\ASS"
Best wishes,
Hans
Hans
-
- PlatinumLounger
- Posts: 4362
- Joined: 26 Apr 2010, 17:36
Re: outlook check if dir and sub dir exisst
i cannot test the code today.HansV wrote:Here is a procedure you can use:
Call it like this: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
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.
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!!!!!!