Wie kann, durch Eingabe eines Namens in einer Excel Zelle, ein gleichnamiger Ordner erstellt werden?

2 Antworten

Vom Beitragsersteller als hilfreich ausgezeichnet
schmiddi1967
Von gutefrage auf Grund seines Wissens auf einem Fachgebiet ausgezeichneter Nutzer
Microsoft Excel
26.07.2015, 18:16

Also nur für Zelle A25 könntest du das auch so machen, da wird bei jeder Änderung in Zelle A25 automatisch das Makro gestartet und der Inhalt aus Zelle A25 als Odrner angelegt:

Sub Worksheet_Change(ByVal Target As Excel.Range)
If Target.Address = "$A$25" Then
Ord = "F:\Kundenkartei\" & Range("A25")
If Dir(Ord, vbDirectory) <> "" Then
MsgBox "Ordner ist schon vorhanden"ElseAntwort = MsgBox("Der Ordner " & Ord & " ist nicht vorhanden." _
& vbNewLine _
& "soll der Ordner angelegt werden?!", vbYesNo)
If Antwort = vbYes Then 'Falls kein LW angegeben ist, erstellt die MkDir-Anweisung 'den neuen Ordner auf dem aktuelle LW. 'LW wurde durch "F:\Kundenkartei\" festgelegt
MkDir Ord
MsgBox "Ordner " & Ord & "angelegt"
Else
MsgBox "es wurden keine Änderungen vorgenommen"
Exit Sub
End If
End If
End If
End Sub
schmiddi1967  26.07.2015, 19:02

ich bin jetzt unterwegs, schaue mir das nachher mal an und gebe dir dann Bescheid.

schmiddi1967  26.07.2015, 21:21
@schmiddi1967

So, ich habe da mal was zusammengebastelt. Schaue mal ob dir das so gefällt. Nur das er automatisch die Zelle auch mit einem Hyperlink in den Ordner setzt bekomme ich da irgendwie nicht mit rein. Sorry da ist mein Latein am Ende :))

Hier werden jetzt die Zellen A1 bis A1000 überprüft, sobald was in diesen Zellen geändert wird, legt das Makro einen Ordner dafür an.

Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
Dim lngLetzteZeile As Long
Dim strOrdner As String
Dim strVerzeichnis As String
Dim intspalte As Integer
Dim objFSO As Object
Dim objFO As Object
Dim objF As Object 
strVerzeichnis = "F:\Kundenkartei\"   
If Target.Column = 1 Then    
strOrdner = Target.Text  
End If  
With ActiveSheet    
lngLetzteZeile = IIf(IsEmpty(.Range("A1000")), .Range("A1000").End(xlUp).Row, 1000)     
If Not Intersect(Target, Range("A1:A" & lngLetzteZeile)) Is Nothing Then      
If Target.Value <> "" And Target.Offset(0, intspalte) <> "" Then        
If Dir(strVerzeichnis & strOrdner, vbDirectory) <> "" Then          
Select Case MsgBox("Ordner wird gelöscht und neu erstellt! Möchten Sie das?", _          
vbYesNo Or vbExclamation Or vbDefaultButton1, "Ordner löschen!")            
Case vbYes              
Set objFSO = CreateObject("Scripting.FileSystemObject")              
Set objFO = objFSO.GetFolder(strVerzeichnis & strOrdner)              
objFO.Delete              
MkDir strVerzeichnis & strOrdner              
.Hyperlinks.Add Anchor:=.Cells(Target.Row, 31), Address:=strVerzeichnis & strOrdner              
.Columns(31).AutoFit              
Exit Sub            
Case vbNo              
Exit Sub          
End Select        
Else          
MkDir strVerzeichnis & strOrdner          
.Hyperlinks.Add Anchor:=.Cells(Target.Row, 31), Address:=strVerzeichnis & strOrdner          
.Columns(31).AutoFit          
MsgBox "Ordner " & strVerzeichnis & strOrdner & " wurde erfolgreich angelegt"        
End If      
End If    
End If  
End With
End Sub
schmiddi1967  27.07.2015, 02:37
@schmiddi1967

So, ich bin doch noch nicht am Ende, dass sollte eigentlich das sein was du suchst. Jetzt wird sobald du was in Spalte A ab A1 einträgst, der dazugehörige Ordner erstellt und im gleichem Atemzug wir auch der Hyperlink zum erstellten Ordner eingefügt.

Mir ist klar es es diesen Code eventuell auch um einiges kürzer gibt, aber nicht von mir :))


Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
Dim lngLetzteZeile As Long
Dim Zelle As Range
Dim strOrdner As String
Dim strVerzeichnis As String
Dim intspalte As Integer
Dim objFSO As Object
Dim objFO As Object
Dim objF As Object
strVerzeichnis = "F:\Kundenkartei\"
If Target.Column = 1 Then
strOrdner = Target.Text
End If
With ActiveSheet
lngLetzteZeile = IIf(IsEmpty(.Range("A500")), .Range("A500").End(xlUp).Row, 500)
If Not Intersect(Target, Range("A1:A" & lngLetzteZeile)) Is Nothing Then
If Target.Value <> "" And Target.Offset(0, intspalte) <> "" Then
If Dir(strVerzeichnis & strOrdner, vbDirectory) <> "" Then
Select Case MsgBox("Ordner wird gelöscht und neu erstellt! Möchten Sie das?", _
vbYesNo Or vbExclamation Or vbDefaultButton1, "Ordner löschen!")
Case vbYes
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFO = objFSO.GetFolder(strVerzeichnis & strOrdner)
objFO.Delete
MkDir strVerzeichnis & strOrdner
.Hyperlinks.Add Anchor:=.Cells(Target.Row, 31), Address:=strVerzeichnis & strOrdner
.Columns(31).AutoFit
Exit Sub
Case vbNo
Exit Sub
End Select
Else
MkDir strVerzeichnis & strOrdner
.Hyperlinks.Add Anchor:=.Cells(Target.Row, 31), Address:=strVerzeichnis & strOrdner
.Columns(31).AutoFit
MsgBox "Ordner " & strVerzeichnis & strOrdner & " wurde erfolgreich angelegt"
End If
End If
End If
End With
Columns("A:A").Select
For Each Zelle In ActiveSheet.Range("A1:A500")  
If Zelle <> "" Then
ActiveCell.Hyperlinks.Add ActiveCell, Address:=strVerzeichnis & ActiveCell.Value
Else
End If
ActiveCell.Offset(1, 0).Select
Next
Range("A1").Select
End Sub

Alles was hier Fett markiert ist, ist neu im Code. Also am besten Komplett austauschen. Es werden jetzt die Zellen von A1 bis A500 überprüft.

Ich hoffe das du so damit klar kommst, wenn nicht immer raus damit.


Yulya 
Beitragsersteller
 16.09.2015, 13:50
@schmiddi1967

Vielen Dank für deine Hilfe und deine Bemühungen!!! das war bestimmt ganz schön zeitintensiv das zu entwickeln! Dankeschön!  ich hatte jetzt ganz lange keine Zeit mehr mich darum zu kümmern, aber ich probiere es jetzt sofort aus und dann kommt die Rückmeldung :)

Yulya 
Beitragsersteller
 16.09.2015, 16:06
@Yulya

Irgendwie funktioniert es leider nicht... Ich habe es mit dem letzten Code ausprobiert, aber es kommt die Fehlermeldung "Fehler beim Kompilieren: Variable nicht definiert" und dabei ist strVerzeichnis = "F:\Kundenkartei\" in den 10. Zeile blau markiert und wenn ich auf "Ok" klicke, ist die zweite Zeile "Private Sub Worksheet_Change (ByVal Target as Range) gelb markiert...

Yulya 
Beitragsersteller
 18.09.2015, 11:25
@schmiddi1967

Jetzt geht es bei mir auch! Vielen, vielen Dank!!! Das ist ganz genau so, wie ich mir das vorgestellt habe :D Danke!
Yulya 
Beitragsersteller
 26.07.2015, 18:46

Vielen lieben Dank für Deine Hilfe! Ich probiere es gleich mal aus :)

Kann ich das irgendwie auch auf die ganze Spalte beziehen? Ich möchte, dass die Namen, die ich in die Liste eintrage auch in der Liste und in der jeweiligen Zelle bleiben :)

Ist das irgendwie möglich, dass, wenn ich in A25 "Mustermann" eingebe, der Ordner "Mustermann" angelegt wird, und wenn ich dann in A26 "Musterfrau" eingebe, der Ordner "Musterfrau" angelegt wird, usw.?
KIReal
26.07.2015, 18:02

Wenn ich nach "Ord = "F:\Kundenkartei\" z.B. Mustermann eingebe und dann F5 drücke, wird ein Unterordner auf dem USB Stick mit dem Namen Mustermann erstellt (wenn "Mustermann" noch nicht vorhanden ist), aber wie könnte ich diesen Code abändern, sodass ich beispielsweise nur noch "Mustermann" in die Zelle A25 eintragen muss und dann der gleichnamige Ordner, am Besten noch mit der Zelle A 25 verknüpft, in dem Ordner "Kundenkartei" eangelegt wird? Und wie kann ich das dann auf alle Zeilen in der Spalte A anwenden?

Kenne mich mit VBA nicht aus, aber folgendes sollte dir helfen:

http://www.office-loesung.de/ftopic65482_0_0_asc.php