Live-Forum - Die aktuellen Beiträge
Datum
Titel
25.04.2024 18:41:19
vba Zeilen duplizieren ab aktiver Zeile bis letzte Zeile
25.04.2024 18:22:55
Zeilen mit bestimmtem Datum in andere Mappe übertragen
25.04.2024 18:14:45
VBA - Excell - Kopie und "Diebstahl" Schützen
25.04.2024 17:49:39
Bedingte Formatierung
Du findest keine passende Antwort auf Deine Frage?
Stelle Deine Frage in unserem Live-Forum
Anzeige
Archiv - Navigation
820to824
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Vorheriger Thread
Vorheriger Thread
Rückwärts Blättern
820to824
820to824
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Nächster Thread
Nächster Thread
Vorwärts blättern
Inhaltsverzeichnis

Verzeichnis prüfen ob vorhanden

Verzeichnis prüfen ob vorhanden
16.11.2006 14:56:34
Walter
Guten Tag,
habe folgendes Makro (überForum) erhalten, funktioniert natürlich.
Hier wird geprüft ob ein Verzeichnis vorhanden ist.
Ich brauch aber jetzt für ein Verzeichnis und ein Unterverzeichnis (Teile).
OrdNam = "C:\Muster\Teile", das Verzeichnis Muster nicht vorhanden ist,
soll es erstellt werden, dann muß natürlich das Unterverzeichnis \Teile\
ebenfalls erstellt werden.
Ferner möchte ich abfragen, wenn das Verzeichnis vorhanden ist aber das
Unterverzeichnis nicht, sollte das Unterverzeichnis erstellt werden. 

Private Sub CommandButton4_Click()
Dim OrdNam As String
Dim DateiNam As String
DateiNam = ActiveWorkbook.Name
On Error Resume Next
' OrdNam = "C:\Muster"
OrdNam = "C:\Muster\Teile"
If Dir(OrdNam, 16) <> "" Then
MsgBox "Ordner:   '" & OrdNam & "'        ist vorhanden !" & Chr(13) _
& Chr(13) & " Datei:  " & "  " & DateiNam & "       " _
& "wird jetzt gespeichert !    ", vbInformation, " Hinweis !"
Application.DisplayAlerts = False                       ' Sicherheitsabfrage unterdrücken
ActiveWorkbook.SaveAs Filename:=(OrdNam & "\" & DateiNam), FileFormat:=xlNormal, _
Password:="", WriteResPassword:="", ReadOnlyRecommended:=False
Else
MsgBox "Ordner '" & OrdNam & "'    ist noch nicht vorhanden !   " & Chr(13) _
& vbCr & "Ordner wird jetzt neu erstellt !" & Chr(13), vbCritical
MkDir OrdNam                ' hier wird Verzeichnis erstellt
End If
''ActiveWorkbook.Close
End Sub

mit freundlichen gruß
walter

13
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Verzeichnis prüfen ob vorhanden
16.11.2006 15:03:46
K.Rola
Hallo,
Option Explicit
Declare 

Function MakeSureDirectoryPathExists Lib "imagehlp.dll" (ByVal Pfad As String) As Long


Sub Pfad_anlegen()
MakeSureDirectoryPathExists "C:\W\a\l\t\e\r\"
End Sub



Ist das Verzeichnis nicht wie angegeben vorhanden, wird es angelegt.

Gruß K.Rola
Fehlermeldung
16.11.2006 15:33:11
Walter
Hallo K.Rola,
Leider Fehlermeldung,

Sub oder 


Function nicht definiert.
Habe so eingesetzt:


Function MakeSureDirectoryPathExists Lib "imagehlp.dll" (ByVal Pfad As String) As Long


Sub Pfad_anlegen()
MakeSureDirectoryPathExists OrdNam = "C:\Muster\Teile"
End Sub



Wo setzte ich meine MsgbOxen ein, als Info möchte ich gern Wissen , Was fehlt ?

mfg walter
Anzeige
AW: Fehlermeldung
16.11.2006 15:45:18
K.Rola
Hallo,
das Declare verrutsch hier immer, das gehört noch zu der Anweisung.
Wozu Msgbox, wenn du den Code ausführst und ein Verzeichnis nicht existiert, wird es angelegt?
Gruß K.Rola
AW: Fehlermeldung
16.11.2006 15:51:35
Rudi
Hallo,
wenn du ein &ltpre&gt davor und ein &lt/pre&gt dahinter setzt, verrutscht's nicht.
Declare Function MakeSureDirectoryPathExists Lib "imagehlp.dll" (ByVal Pfad As String) As Long
Gruß Rudi
Noch immer, was mache ich Falsch?
16.11.2006 16:01:58
Walter
Hallo Rudi,
leider noch gleiche Fehlermeldung, so stehts bei mir im Modul:
Declare 

Function MakeSureDirectoryPathExists Lib "imagehlp.dll" (ByVal Pfad As String) As Long


Sub Pfad_anlegen()
Dim OrdNam As String
MakeSureDirectoryPathExistsLib OrdNam = "C:\Muster\Teile"
End Sub



Was habe ich FALSCH gemacht ?

mfg walter
Anzeige
AW: Noch immer, was mache ich Falsch?
16.11.2006 16:07:34
Rudi
Hallo,
es muss

Declare Function MakeSureDirectoryPathExists Lib "imagehlp.dll" (ByVal Pfad As String) As Long

am Anfang des Moduls stehen.
Gruß
Rudi
Eine Kuh macht Muh, viele Kühe machen Mühe
Kein Fehler aber auch keine Reaktion
16.11.2006 16:23:16
Walter
Hallo Rudi,
keine Fehlermeldung aber auch keine Reaktion:
Declare 

Function MakeSureDirectoryPathExists Lib "imagehlp.dll" (ByVal Pfad As String) As Long
Option Explicit


Sub Pfad_anlegen()
Dim OrdNam As String
MakeSureDirectoryPathExists OrdNam = "C:\Muster\Teile"
End Sub



Blöde FRage:

Kann man mein altes Makro nicht entsprechend anpassen ?

Dann würde ich auch meine MSGBOXen drin haben,

mfg Walter

mfg Walter
Anzeige
AW: Verzeichnis prüfen ob vorhanden
16.11.2006 17:50:30
Reinhard
Hi Walter,
Option Explicit
Sub Pfad_anlegen()
Dim fs As Object, OrdNam As Variant, Ord As Byte, Pfad As String
OrdNam = Split("C:\Muster\Teile", "\")
Pfad = OrdNam(0) & "\"
ChDrive Left(OrdNam(0), 1)
For Ord = 1 To UBound(OrdNam)
ChDir Pfad
Set fs = CreateObject("Scripting.FileSystemObject")
If Not fs.folderexists(Pfad & OrdNam(Ord)) Then
MkDir OrdNam(Ord)
MsgBox "Der Ordner " & vbLf & vbLf & Pfad & OrdNam(Ord) & vbLf & vbLf & " wurde erstellt."
Else
MsgBox "Der Ordner " & vbLf & vbLf & Pfad & OrdNam(Ord) & vbLf & vbLf & " existiert bereits."
End If
Pfad = Pfad & OrdNam(Ord) & "\"
Next Ord
Set fs = Nothing
ChDir "C:\" 'um C:\Muster löschen zu können
End Sub

Gruß
Reinhard
ps: Ich freue mich über eine Rückmeldung ob diese Antwort hilfreich war oder nicht..
Anzeige
Danke so funktioniert Super -ende)
17.11.2006 08:59:51
Walter
Guten Morgen Reinhard,
DANKE, funktioniert prima,
mfg walter
Bitte Erklärung reinsetzen
17.11.2006 12:54:27
walter
Hallo Reinhard,
funktioniert, möchte allerdings etwas lernen und deshalb die Zeilen:
Set fs = CreateObject("Scripting.FileSystemObject")
If Not fs.folderexists(Pfad & OrdNam(Ord)) Then
etc. was das bewirkt bzw. eine Erklärung dahinter schreiben, geht das ?
Wenn ja, Danke im voraus,
mfg Walter
Leider nicht speichern
17.11.2006 13:07:55
walter
Hallo Reinhard,
wollte gerade das speichern "reinsetzen" sobald das Unterverzeichnis "Teile" das ist,
leider keine Reaktion.
Habe so eingesetzt:

Private Sub CommandButton4_Click()
'Sub Pfad_anlegen()
Dim fs As Object, OrdNam As Variant, Ord As Byte, Pfad As String
Dim DateiNam As String
DateiNam = ActiveWorkbook.Name
On Error Resume Next
OrdNam = Split("C:\Muster\Teile", "\")
Pfad = OrdNam(0) & "\"
ChDrive Left(OrdNam(0), 1)
For Ord = 1 To UBound(OrdNam)
ChDir Pfad
Set fs = CreateObject("Scripting.FileSystemObject")
If Not fs.folderexists(Pfad & OrdNam(Ord)) Then
MkDir OrdNam(Ord)
MsgBox "Der Ordner " & vbLf & vbLf & Pfad & OrdNam(Ord) & vbLf & vbLf & " wurde erstellt."
Else
MsgBox "Der Ordner " & vbLf & vbLf & Pfad & OrdNam(Ord) & vbLf & vbLf & " existiert bereits."
End If
Pfad = Pfad & OrdNam(Ord) & "\"
Next Ord
Set fs = Nothing
ChDir "C:\"                 'um C:\Muster löschen zu können
' Application.DisplayAlerts = False
ActiveWorkbook.SaveAs Filename:=(OrdNam(Ord) & "\" & DateiNam), FileFormat:=xlNormal, _
Password:="", WriteResPassword:="", ReadOnlyRecommended:=False
End Sub

Anzeige
AW: Leider nicht speichern
17.11.2006 23:10:13
Reinhard
Hi Walter,
über
Set fs = CreateObject("Scripting.FileSystemObject")
If Not fs.folderexists(Pfad & OrdNam(Ord)) Then
weiß ich auch nur was in der Hilfe steht.
Es stimmt nicht daß sich nix tut, du siehst nur nix durch On error goto next, sonst wäre eine Fehlermeldung gekommen, weil es nach einer "Ord"-For Next Schleife kein OrdNam(Ord) geben kann, aber das sind Grundlagen einer For-next Schleife.
Einen neuen Thread aufzumachen während der alte noch läuft wird überall ungern gesehen.
Das ist absolut nicht böse gemeint, so wie auch der Hinweis diesbezüglich des Anderen, ist hilfreich gemeint.
Option Explicit
'Private Sub CommandButton4_Click()
Sub Pfad_anlegen()
Dim fs As Object, OrdNam As Variant, Ord As Byte, Pfad As String
Dim DateiNam As String
DateiNam = ActiveWorkbook.Name
On Error Resume Next
OrdNam = Split("C:\Muster\Teile", "\")
Pfad = OrdNam(0) & "\"
ChDrive Left(OrdNam(0), 1)
For Ord = 1 To UBound(OrdNam)
ChDir Pfad
Set fs = CreateObject("Scripting.FileSystemObject")
If Not fs.folderexists(Pfad & OrdNam(Ord)) Then
MkDir OrdNam(Ord)
MsgBox "Der Ordner " & vbLf & vbLf & Pfad & OrdNam(Ord) & vbLf & vbLf & " wurde erstellt."
Else
MsgBox "Der Ordner " & vbLf & vbLf & Pfad & OrdNam(Ord) & vbLf & vbLf & " existiert bereits."
End If
Pfad = Pfad & OrdNam(Ord) & "\"
Next Ord
Set fs = Nothing
'ChDir "C:\"                 'um C:\Muster löschen zu können
' Application.DisplayAlerts = False
ActiveWorkbook.SaveAs Filename:=Pfad & DateiNam, FileFormat:=xlNormal, _
Password:="", WriteResPassword:="", ReadOnlyRecommended:=False
End Sub

Gruß
Reinhard
ps: Ich freue mich über eine Rückmeldung ob diese Antwort hilfreich war oder nicht..
Anzeige
So jetzt, alles i.o. -)
18.11.2006 13:41:59
Walter
Hallo Reinhard,
jetzt ist alles I.O., Danke für alles
mfg Walter schönes Wochenende.

Links zu Excel-Dialogen

CommandButton

Beliebteste Forumthreads (12 Monate)

Anzeige
Jetzt das Excel-Portal bewerten: Deine Stimme zählt!

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige