Dim swFolder as Sharedworkspacefolder
Dim swParent as Sharedworkspacefolder
Dim newFolder as Sharedworkspacefolder
If Activeworkbook.Sharedworkspace.folders.itemcountexceeded=True Then
MsgBox "No more Folders or Files can be created automatically." & vbcrlf & _
"The displayable number of 99 folders and files has been exceeded.", _
vbinformation, "ItemCountExceeded"
ElseIf Activeworkbook.Sharedworkspace.folders.count > 0 and _
activeworkbook.sharedworkspace.folders.count < 99 Then
For each swFolder in Activeworkbook.sharedworkspace.folders
If swFolder.name = "[searched Folder]"
Set swParent = swFolder
End If
Next
Set newFolder = ActiveWorkbook.SharedWorkspace.Folders.Add("MyNewFolder", parent)
MsgBox "New Folder: " & newFolder.FolderName, _
vbInformation + vbOKOnly, _
"New Folder in Shared Workspace"
Set newFolder = Nothing
Set swParent = Nothing