Page 1 of 1
outlook check if dir and sub dir exist
Posted: 11 Sep 2012, 20:23
by 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
Re: outloo check if dir and sub dir exisst
Posted: 11 Sep 2012, 20:26
by 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?
Re: outloo check if dir and sub dir exisst
Posted: 11 Sep 2012, 20:45
by sal21
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%
Re: outlook check if dir and sub dir exisst
Posted: 11 Sep 2012, 20:58
by HansV
I have moved this thread to the VB/VBA forum.
Re: outlook check if dir and sub dir exisst
Posted: 11 Sep 2012, 21:17
by 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.
Re: outlook check if dir and sub dir exisst
Posted: 12 Sep 2012, 08:04
by sal21
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!
but as usual you read in my mind!!!!!!