online 1
gast (50)

/ Forum / Tabellenkalkulation

TabellenkalkulationTabellenkalkulation

Fragevon Elhamplo vom 21.10.2020, 09:48 Options

Ordner erstellen und Datei in Ordner speichern

Hallo,

ich brauche Eure Hilfe!!!!

Ich möchte gerne per Makro eine Datei speichern. Problem ist, es soll erst ein Ordner mit dem gleichen Namen wie die Datei in ein Verzeichnis angelegt werden. Der Name der Datei alphanumerisch und steht in der Zelle D8.

Hat jemand eine Idee??

Vielen Dank für Eure Mühen!!!

Gruß

Elhamplo


Antwort schreiben

Antwort 1 von nighty vom 21.10.2020, 15:26 Options

hi Elhamplo :-)

vielleicht so ?

gruss nighty

Option Explicit
Sub Beispiel()
MkDir ThisWorkbook.Path & "\" & Cells(8, 4)
End Sub

Antwort 2 von Elhamplo vom 24.10.2020, 09:27 Options

Hallo nighty,

sorry, aber ich komm jetzt ers dazu Dir zu antworten. Bin echt im Stress.

Klappt irgendwie nicht. WWo muss ich denn den Pfad eingeben, in welches Verzeichnis der Ordner angelegt werden soll und in den Ordner soll ja auch die Datei.

Danke!

Gruß

Elhamplo

Antwort 3 von nighty vom 25.10.2020, 18:11 Options

hi Elhamplo :-)

dann stueckchenweise :-)

das auszufuehrende makro ist dieses
DirAuswahl

zur info stehen dort 2 rem zeilen

gruss nighty

Option Private Module
Option Explicit
Public Type BROWSEINFO
    hOwner As Long
    pidlRoot As Long
    pszDisplayName As String
    lpszTitle As String
    ulFlags As Long
    lpfn As Long
    lParam As Long
    iImage As Long
End Type
Declare Function SHGetPathFromIDList Lib "shell32.dll" _
    Alias "SHGetPathFromIDListA" (ByVal pidl As Long, ByVal pszPath As String) As Long
Declare Function SHBrowseForFolder Lib "shell32.dll" _
  Alias "SHBrowseForFolderA" (lpBrowseInfo As BROWSEINFO) As Long
Sub DirAuswahl()
Dim Dpfad As String, Meldung As String
Dim msg As Variant
Dpfad = getdirectory(msg) & "\"
If Dir(Dpfad & Cells(8, 4), vbDirectory) <> Cells(8, 4) Then
MkDir Dpfad & Cells(8, 4)
Dpfad = Dpfad & Cells(8, 4) & "\"
Rem hier sollte deine datei wohl gespeichert werden,welche ?
Rem der pfad waere zur zeit in der variablen Dpfad ,anzufuegen waere der dateiname bzw ueber index
Else
Meldung = MsgBox("Ein Ordner mit dem Namen " & Cells(8, 4) & " gibt es schon !", vbOK)
End If
End Sub
Function getdirectory(Optional msg) As String
    Dim bInfo As BROWSEINFO
    Dim Path As String
    Dim r As Long, x As Long, pos As Integer
    bInfo.pidlRoot = 0&
    If IsMissing(msg) Then
        bInfo.lpszTitle = "Wählen Sie bitte einen Ordner aus."
    Else
        bInfo.lpszTitle = msg
    End If
    bInfo.ulFlags = &H1
    x = SHBrowseForFolder(bInfo)
    Path = Space$(512)
    r = SHGetPathFromIDList(ByVal x, ByVal Path)
    If r Then
        pos = InStr(Path, Chr$(0))
        getdirectory = Left(Path, pos - 1)
    Else
        getdirectory = ""
    End If
End Function

Antwort 4 von nighty vom 25.10.2020, 18:33 Options

hi Elhamplo :-)

das waere eine variante,wobei der gross geschriebene text anzupassen waere oder durch zellangaben ersetzt werden koennte,wie auch activeworkbook durch name oder index eventuell anzupassen waere

gruss nighty

ActiveWorkbook.SaveAs Filename:=Dpfad & "DEIN DATEI NAME" & ".xls", FileFormat:=xlNormal, Password:="", WriteResPassword:=""

Antwort 5 von Elhamplo vom 28.10.2020, 08:25 Options

Hallo,

erst mal vielen Dank.

Sorry aber irgendwie versteh ich das ganze garnicht. Muss ich den Speicherort selbst angeben??

Ich steh gerade irgendwie auf dem Schlauch!

Gruß

Elhamplo

Antwort 6 von nighty vom 28.10.2020, 14:10 Options

hi Elhamplo :-)

du warst auch schon mal fitter :-))

hab es nun fertig gemacht,wobei ich dir eigentlich zum selbsverstaendnis einiges ueberlassen wollte,nun ist es so wie du dir es wohl vorstellst

gruss nighty

 Option Private Module
Option Explicit
Public Type BROWSEINFO
    hOwner As Long
    pidlRoot As Long
    pszDisplayName As String
    lpszTitle As String
    ulFlags As Long
    lpfn As Long
    lParam As Long
    iImage As Long
End Type
Declare Function SHGetPathFromIDList Lib "shell32.dll" _
    Alias "SHGetPathFromIDListA" (ByVal pidl As Long, ByVal pszPath As String) As Long
Declare Function SHBrowseForFolder Lib "shell32.dll" _
  Alias "SHBrowseForFolderA" (lpBrowseInfo As BROWSEINFO) As Long
Sub DirAuswahl()
Dim Dpfad As String, Meldung As String
Dim msg As Variant
Dpfad = getdirectory(msg) & "\"
If Dir(Dpfad & Cells(8, 4), vbDirectory) <> Cells(8, 4) Then
MkDir Dpfad & Cells(8, 4)
Dpfad = Dpfad & Cells(8, 4) & "\"
ActiveWorkbook.SaveAs Filename:=Dpfad & ActiveWorkbook.Sheets(1).Range("D8") & ".xls", FileFormat:=xlNormal, Password:="", WriteResPassword:=""
Else
Meldung = MsgBox("Ein Ordner mit dem Namen " & Cells(8, 4) & " gibt es schon !", vbOK)
End If
End Sub
Function getdirectory(Optional msg) As String
    Dim bInfo As BROWSEINFO
    Dim Path As String
    Dim r As Long, x As Long, pos As Integer
    bInfo.pidlRoot = 0&
    If IsMissing(msg) Then
        bInfo.lpszTitle = "Wählen Sie bitte einen Ordner aus."
    Else
        bInfo.lpszTitle = msg
    End If
    bInfo.ulFlags = &H1
    x = SHBrowseForFolder(bInfo)
    Path = Space$(512)
    r = SHGetPathFromIDList(ByVal x, ByVal Path)
    If r Then
        pos = InStr(Path, Chr$(0))
        getdirectory = Left(Path, pos - 1)
    Else
        getdirectory = ""
    End If
End Function

Antwort 7 von Elhamplo vom 29.10.2020, 13:42 Options

Hallo,

jetzt hab ich das ganze System verstanden. Danke Super.

Noch eine Frage, wo kann ich den Speicherort festlegen??

Danke für die Hilfe die Du Dir gemacht hast.

Gruß

Elhamplo

Antwort 8 von nighty vom 29.10.2020, 13:51 Options

hi Elhamplo :-)

den speicherort bestimmst du durch die auswahl des ordners mit bezug auf die zelle Cells(8, 4)

so wolltest du es doch ,oder nicht ?

gruss nighty

Antwort 9 von Elhamplo vom 03.11.2020, 08:58 Options

Hallo,

Sorry.

Ich wollte eigentlich, das der Speicherort im Code festgelegt wird:

Beispiel: D:\Projekte\Test

In dem Verzeichnis soll sich die Datei dann speichern, mit dem Namen aus D8 soll aber im Verzeichnis einen Ordner anlegen. Der Ordner soll so heißen wie die Datei, Bezeichnug aus D8.

Danke!

Gruß

Elhamplo

Ähnliche Themen

Ordner aus Zellen erstellen
Wuschl32  17.04.2007 - 113 Hits - 3 Antworten

Datei automatisch in einen Ordner Speichern
Elhamplo  11.07.2008 - 170 Hits - 2 Antworten

Hinweis

Diese Frage ist schon etwas älter, Sie können daher nicht mehr auf sie antworten. Sollte Ihre Frage noch nicht gelöst sein, stellen Sie einfach eine neue Frage im Forum..

Neue Einträge

Version: supportware 1.9.150 / 10.06.2022, Startzeit:Thu Jan 8 21:07:44 2026