Thema Datum  Von Nutzer Rating
Antwort
Rot Ordnerstruktur mit VBA
 28.12.2017 08:20:51 Søren
NotSolved
28.12.2017 11:19:46 Gast13447
NotSolved
29.12.2017 08:19:30 Søren
Solved

Ansicht des Beitrags:
Von:
Søren		 Datum:
28.12.2017 08:20:51		 Views:
931		 Rating:
     
Antwort:
  Ja
Thema:
Ordnerstruktur mit VBA

 

Hey hey hey exelmania....;-)

 

Mein Code hier, den ich mit Euch zusammen schon verbessern konnte, macht mir noch ein paar Problemchen......

Ich habe eine Tabelle mit vielen Spalten in denen Daten für Projekte stehen...diese werden dann in einigen weiteren Makros weiter verarbeitet.

Ein Makro erstellt mir eine Ordnerstruktur zu jedem Projekt....funktioniert prima....:-), das Makro benutzt dafür die Daten aus der Datei Projektübersicht,

unter anderem aber auch das aktuelle Jahr.

Jetzt habe ich gemerkt, das ich ab und an die vorhandene Ordnerstruktur überarbeiten möchte, also einige Ordner weg oder neue dazu, ohne die Daten

darin zu löschen oder zu verschieben oder ähnliches. Das funktioniert mit unten gezeigtem Code auch wunderbar für die projekte im laufenden Jahr.

Hier nun mein Problem: die projekte z.B. aus 2016, bei der die Ordnerstruktur mit Kunde, dann Jahr (2016)....usw. beginnt, lässt das Makro unberührt

und erstellt stattdessen die Ordnerstruktur für das Jahr 2017 mit diesem Projekt.....das ist mein Problemchen...

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:

?
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
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

 

hat da jemand eine Idee von Euch, wie das funktionieren könnte...??? Dazu finde ich leider nix im Netz...

 

 

 

 

Ihre Antwort
  • Bitte beschreiben Sie Ihr Problem möglichst ausführlich. (Wichtige Info z.B.: Office Version, Betriebssystem, Wo genau kommen Sie nicht weiter)
  • Bitte helfen Sie ebenfalls wenn Ihnen geholfen werden konnte und markieren Sie Ihre Anfrage als erledigt (Klick auf Häckchen)
  • Bei Crossposting, entsprechende Links auf andere Forenbeiträge beifügen / nachtragen
  • Codeschnipsel am besten über den Code-Button im Text-Editor einfügen
  • Die Angabe der Emailadresse ist freiwillig und wird nur verwendet, um Sie bei Antworten auf Ihren Beitrag zu benachrichtigen
Thema: Name: Email:



  • Bitte beschreiben Sie Ihr Problem möglichst ausführlich. (Wichtige Info z.B.: Office Version, Betriebssystem, Wo genau kommen Sie nicht weiter)
  • Bitte helfen Sie ebenfalls wenn Ihnen geholfen werden konnte und markieren Sie Ihre Anfrage als erledigt (Klick auf Häckchen)
  • Bei Crossposting, entsprechende Links auf andere Forenbeiträge beifügen / nachtragen
  • Codeschnipsel am besten über den Code-Button im Text-Editor einfügen
  • Die Angabe der Emailadresse ist freiwillig und wird nur verwendet, um Sie bei Antworten auf Ihren Beitrag zu benachrichtigen

Thema Datum  Von Nutzer Rating
Antwort
Rot Ordnerstruktur mit VBA
 28.12.2017 08:20:51 Søren
NotSolved
28.12.2017 11:19:46 Gast13447
NotSolved
29.12.2017 08:19:30 Søren
Solved