Ordner erstellen

Hallo zusammen und frohe Ostern,
ich kämpfe mit folgendem Problem:
Aus einer Datei soll aus einem Tabellenblatt eine neue Arbeitsmappe generiert werden.
Es soll jetzt so sein, das der neue Ordner den Namen aus Zelle B1 bekommt die Arbeitsmappe jedoch den Namen aus Zelle C1 bekommt.
Ich stelle mir vor das der Ordner (Name aus Zelle B1) in einem bestimmten Pfad abgelegt wird "C\OrdnerA\OrdnerB\". Die Arbeitsmappe (Name aus Zelle C1) soll sich in diesem Ordner befinden. Es müsste eine Prüfung stattfinden, ob der Ordner mit dem Namen schon vorhanden ist, da mit der Zeit weitere Arbeitsmappen in diesem Ordner abgelegt werden sollen.
Ich hoffe ich habe mich halbwegs verständlich ausgedrückt.
Ich habe die Recherche schon bemüht, aber nichts brauchbares für mich gefunden (oder übersehen)
Ich hoffe jemand hat einen Tip für mich.
Danke und
Gruß Volker

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Sub test() Debug.Print fpExists("C:\Windows") Debug.Print fpExists("C:\Windows\test.txt") End Sub Private Function fpExists(ByVal pName As String) As Boolean fpExists = Dir(pName, vbDirectory) vbNullString End Function

Hallo Volker,
nachstehender Code erstellt den gewünschten Ordner (falls er noch nicht existiert) und speichert das aktuelle Tabellenblatt als eigene Datei in diesem Ordner.
Deine Beispieldatei ist im XLS-Format. Das Makro speichert die neue Datei ebenfalls im xls-Format. Falls Du sie aber lieber in den neuen Formaten (xlsx oder xlsm) speichern willst, musst Du nur die entsprechenden Zeilen in dem Makro aktivieren (Hochkomma (') setzen bzw. entfernen).

Sub DateiErstellen()
Dim strPfad As String   'Start-Pfad
Dim strOrdner As String 'Ordnername
Dim strDatei As String  'Dateiname
strPfad = "C\OrdnerA\OrdnerB\"
strOrdner = Range("B1")
strDatei = Range("C1")
If Dir(strPfad & strOrdner, vbDirectory) = "" Then MkDir strPfad & strOrdner
ActiveSheet.Copy
'speichern im *.xls-Format (altes Excel-Format):
ActiveWorkbook.SaveAs Filename:=strPfad & strOrdner & "\" & strDatei & ".xls", FileFormat:= _
xlExcel8
'speichern im *.xlsm-Format (mit Makros):
ActiveWorkbook.SaveAs Filename:=strPfad & strOrdner & "\" & strDatei & ".xlsm", FileFormat:= _
xlOpenXMLWorkbookMacroEnabled
'speichern im *.xlsx-Format (ohne Makros):
'Application.DisplayAlerts = False
'ActiveWorkbook.SaveAs Filename:=strPfad & strOrdner & "\" & strDatei & ".xlsx", FileFormat:= _
xlOpenXMLWorkbook
'Application.DisplayAlerts = True
End Sub

Gruß
Robert

Option Explicit Declare Function MakePath& Lib "imagehlp.dll" Alias _ "MakeSureDirectoryPathExists" (ByVal sPath$) Sub CreatePath_() Dim strPath As String strPath = Environ("UserProfile") & "\Desktop\Test\1\2\" MakePath strPath End Sub

Sub M_snb() Application.DisplayAlerts = False c00 = CreateObject("wscript.shell").specialfolders(4) With Tabelle1 c01 = "Neu\Module\" & Replace([B1], " ", "_") c02 = "\" & Replace(Replace([c1], ".", "_"), " ", "_") & ".xlsx" CreateObject("shell.application").Namespace(c00).NewFolder c01 .Copy ActiveWorkbook.SaveAs c00 & "\" & c01 & c02 ActiveWorkbook.Close 0 End With End Sub

Beliebteste Forumthreads (12 Monate)

24 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

24
Beiträge zum Forumthread

Beiträge zu diesem Forumthread