Zur Verkn\u00fcpfung von Dokumenten an einen Ordner empfiehlt es sich Ordner anzulegen. Wie mache ich das, wenn ich die Ordner automatisiert per VBA anlegen will?<\/p>\n\n\n\n
Wir k\u00f6nnen zum einen Ordner f\u00fcr die ausgew\u00e4hlten Vorg\u00e4nge anlegen<\/p>\n\n\n\n
Sub Ordneranlegen()\nDim tsk As task, vAblage As String\n\n\nvAblage = ActiveProject.Path & \"\\\"\nFor Each tsk In ActiveSelection.Tasks\n\nMkDir vAblage & tsk.Name\n\nNext\nEnd Sub<\/code><\/pre>\n\n\n\nAlternativ k\u00f6nnen wir auch Ordner f\u00fcr alle markierten Vorg\u00e4nge im Projekt anlegen und dabei die Gliederung zu ber\u00fccksichtigen.<\/p>\n\n\n\n
Sub CreateFoldersFromWBS()\n\n Dim t As Task\n Dim wbs As String\n Dim path As String\n Dim BasePath As String\n Dim i As Integer\n Dim elements() As String\n Dim currentPath As String\n\n '*** Pfad ggf. anpassen ***<\/em>\n BasePath = \"C:\\ProjectFolders\" ' Zielordner\n \n ' *** Grundordner anlegen, falls nicht vorhanden ***<\/em>\n If Dir(BasePath, vbDirectory) = \"\" Then\n MkDir BasePath\n End If\n\n For Each t In ActiveProject.Tasks\n If Not t Is Nothing Then\n If t.Summary = False Or t.OutlineLevel = 1 Then\n If Trim(t.Name) <> \"\" Then\n\n ' *** WBS-Nummer (z. B. \"1.2.3\") ***<\/em>\n wbs = t.OutlineNumber\n\n ' *** WBS zerlegen ***<\/em>\n elements = Split(wbs, \".\")\n\n ' *** Pfad St\u00fcck f\u00fcr St\u00fcck aufbauen ***<\/em>\n currentPath = BasePath\n \n For i = LBound(elements) To UBound(elements)\n \n ' *** Name des jeweiligen Abschnitts = OutlineNumber bis zur aktuellen Ebene ***<\/em>\n Dim levelWBS As String\n levelWBS = Join$(Split(wbs, \".\", i + 1), \".\")\n \n ' *** passenden Vorgang zur aktuellen Ebene finden ***<\/em>\n Dim t2 As Task\n For Each t2 In ActiveProject.Tasks\n If Not t2 Is Nothing Then\n If t2.OutlineNumber = levelWBS Then\n \n ' Ordnername = \"WBS - Vorgangsname\"\n currentPath = currentPath & \"\\\" & levelWBS & \" - \" & CleanFileName(t2.Name)\n \n ' Ordner anlegen, wenn n\u00f6tig\n If Dir(currentPath, vbDirectory) = \"\" Then\n MkDir currentPath\n End If\n \n Exit For\n End If\n End If\n Next t2\n Next i\n \n End If\n End If\n End If\n Next t\n\n MsgBox \"Ordnerstruktur erfolgreich erstellt!\", vbInformation\n\nEnd Sub\n\n\n' *** Hilfsfunktion: Ung\u00fcltige Ordnerzeichen entfernen ***<\/em>\nFunction CleanFileName(fname As String) As String\n Dim invalidChars As Variant\n invalidChars = Array(\"\\\", \"\/\", \":\", \"*\", \"?\", \"\"\"\", \"<\", \">\", \"|\")\n \n Dim c As Variant\n For Each c In invalidChars\n fname = Replace(fname, c, \"_\")\n Next\n CleanFileName = fname\nEnd Function\n\n<\/code><\/pre>\n","protected":false},"excerpt":{"rendered":"