also vielen Dank erstmal für Deine Hilfe.....hab es versucht, hat aber leider nicht funktioniert....hab ich wohl was falsch gemacht.
Aber die Lösung von vorher funktioniert ja erstmal, ich beschäftige mich im Anschluß an mein richtiges problem damit...
Und zwar hab ich nun bemerkt, das mein code auch für ältere Projekte (also älter als dieses Jahr) eine komplette neue Ordnerstruktur anlegt, allerdings
im aktuellen Jahr, so wie es das Makro auch beschreibt. Die Ordner des älteren Projektes bleiben von der Veränderung unberührt.
Wenn ich nun aber die komplette Ordnerstruktur ändern möchte für alle Projekte habe ich natürlich ein Problem mit den Projekten die älter als das aktuelle Jahr sind.
Da ich nun aber gern möchte, das auch die älteren Projekte ordentlich umstrukturiert werden, aber im richtigen Jahr verbleiben, habe ich eine Userform eingefügt
mit einer textbox und einem button. Hier soll nun das Jahr eingetragen werden, in dem die Ordner angepasst werden sollen. Noch schöner wäre es natürlich, man führt
einfach das makro aus und alle Ordner, egal aus welchem jahr werden umorganisiert, aber verbleiben in Ihrem Jahr....
das problem ist ziemlich scwierig zu erklären, ich hoffe aber ihr könnt mich verstehen....
hier mal der Code:
Private Sub alle_Ordner_neu_Click()
Dim lngReturn As Long, lngErrorNumber As Long
Dim strBuffer As String
Dim intNr As Long
Dim c As Integer
Dim f As Integer
With Worksheets("Projektübersicht").Columns(1)
c = .Cells(ActiveCell.Row, 1).End(xlUp).Row
c = f + 1
UserForm9.Show
if userform9.TextBox1.Text <> .......'hier komme ich nicht weiter...;-(
For c = 5 To 200
If Worksheets("Projektübersicht").Cells(c, 1) = "" Then Exit For
Application.EnableEvents = False
lngReturn = MakeSureDirectoryPathExists("C:\" & "Projekte" & "\" & Worksheets("Projektübersicht").Cells(c, 33) & "\" & Year(Now) & "\" & Worksheets("Projektübersicht").Cells(c, 3) & "\" & "Intern" & " " & Worksheets("Projektübersicht").Cells(c, 1).Text & " " & Worksheets("Projektübersicht").Cells(c, 3) & "\\" & "Auftragsdokumentation_Blanco" & "\")
MakeSureDirectoryPathExists ("C:\" & "Projekte" & "\" & Worksheets("Projektübersicht").Cells(c, 33) & "\" & Year(Now) & "\" & Worksheets("Projektübersicht").Cells(c, 3) & "\" & "Intern" & " " & Worksheets("Projektübersicht").Cells(c, 1).Text & " " & Worksheets("Projektübersicht").Cells(c, 3) & "\\" & "Auftragsdokumentation_Rücklauf" & "\" & "\" & "Fotodokumentation" & "\")
MakeSureDirectoryPathExists ("C:\" & "Projekte" & "\" & Worksheets("Projektübersicht").Cells(c, 33) & "\" & Year(Now) & "\" & Worksheets("Projektübersicht").Cells(c, 3) & "\" & "Intern" & " " & Worksheets("Projektübersicht").Cells(c, 1).Text & " " & Worksheets("Projektübersicht").Cells(c, 3) & "\\" & "Auftragsdokumentation_Rücklauf" & "\" & "\" & "Durchführungsbestätigungen" & "\")
MakeSureDirectoryPathExists ("C:\" & "Projekte" & "\" & Worksheets("Projektübersicht").Cells(c, 33) & "\" & Year(Now) & "\" & Worksheets("Projektübersicht").Cells(c, 3) & "\" & "Intern" & " " & Worksheets("Projektübersicht").Cells(c, 1).Text & " " & Worksheets("Projektübersicht").Cells(c, 3) & "\\" & "Anfrage, Angebot, Projektdaten" & "\" & "\" & "Kundenfotos" & "\")
MakeSureDirectoryPathExists ("C:\" & "Projekte" & "\" & Worksheets("Projektübersicht").Cells(c, 33) & "\" & Year(Now) & "\" & Worksheets("Projektübersicht").Cells(c, 3) & "\" & "Intern" & " " & Worksheets("Projektübersicht").Cells(c, 1).Text & " " & Worksheets("Projektübersicht").Cells(c, 3) & "\\" & "Anfrage, Angebot, Projektdaten" & "\" & "\" & "Mailverkehr" & "\")
If Dir("C:\" & "Projekte" & "\" & Worksheets("Projektübersicht").Cells(c, 33) & "\" & Year(Now) & "\" & Worksheets("Projektübersicht").Cells(c, 3) & "\" & "Intern" & " " & Worksheets("Projektübersicht").Cells(c, 1).Text & " " & Worksheets("Projektübersicht").Cells(c, 3) & "\" & "Verlauf.txt") = "" Then
Open ("C:\" & "Projekte" & "\" & Worksheets("Projektübersicht").Cells(c, 33) & "\" & Year(Now) & "\" & Worksheets("Projektübersicht").Cells(c, 3) & "\" & "Intern" & " " & Worksheets("Projektübersicht").Cells(c, 1).Text & " " & Worksheets("Projektübersicht").Cells(c, 3) & "\" & "Verlauf.txt") For Output As #1
Print #1, "Projektverlauf:" & " " & "Datei wurde angelegt am:" & " " & Date & "/" & " " & Time & " " & "Für das Projekt:" & "Intern" & " " & Worksheets("Projektübersicht").Cells(c, 1).Text & " "
Close #1
End If
If lngReturn = 0 Then
lngErrorNumber = Err.LastDllError
strBuffer = Space$(200)
Call FormatMessageA(FORMAT_MESSAGE_FROM_SYSTEM, ByVal 0&, _
lngErrorNumber, LANG_NEUTRAL, strBuffer, 200, ByVal 0&)
Call MsgBox("Fehler: " & CStr(lngErrorNumber) & vbLf & vbLf & _
strBuffer, vbCritical, "Fehler beim Anlegen der Ordner")
'Else
Cells(c, 41).Select
ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:="C:\" & "Projekte" & "\" & Worksheets("Projektübersicht").Cells(c, 33) & "\" & Year(Now) & "\" & Worksheets("Projektübersicht").Cells(c, 3) & "\" & "Intern" & " " & Worksheets("Projektübersicht").Cells(c, 1).Text & " " & Worksheets("Projektübersicht").Cells(c, 3), TextToDisplay:="angelegt am" & " " & Date & " " & "von" & " " & Environ("COMPUTERNAME") 'Hyperlink wird eingefügt
End If
Next c
End With
Call MsgBox("Die Ordner wurden erfolgreich angelegt.", vbInformation, "Information")
Application.EnableEvents = True
Unload Me
End Sub
|