Prüfen ob Pfad existiert wenn nicht erstellen

Informationen und Beispiele zu den hier genannten Dialog-Elementen:
InputBox MsgBox


Excel-Version: 10.0 (Office XP)
nach unten

Betrifft: Prüfen ob Pfad existiert wenn nicht erstellen
von: Steve
Geschrieben am: 19.06.2002 - 17:40:51

Hi,
Besitze folgendes Makro:

Private Sub Speichern()
Dim strDate As String
Dim strGeneralDir As String
Dim strYearDir As String
Dim strpath As String
Dim strNameDir As String
Dim strMonthDir As String

strDate = Format(Now, "mm.yy")
strYearDir = Format(Now, "yyyy")
strGeneralDir = "c:\Unternehmensplanung\Projekte"
strNameDir = "Kat.D" & " " & Workbooks("Unternehmensplanung - Einzelprojekt.xls").Worksheets("Projektdaten").cells(5, 2)
strpath = strGeneralDir & " " & strYearDir


If Not PathExists(strpath) Then MkDir (strpath)

ThisWorkbook.SaveAs (strpath & "\" & strNameDir & " " & strDate & ".xls")


MsgBox ("Arbeitsmappe wird gespeichert in:" + Chr(13) + strpath & "\" & strNameDir & ".xls")

Worksheets("Tabelle").Activate

End Sub

Private Function PathExists(strpath) As Boolean
Dim x As String
On Error Resume Next
x = GetAttr(strpath) And 0
If Err = 0 Then
PathExists = True
ElseIf PathExists = False Then
End If
End Function

Das makro soll überpüfen ob der Ordner Projekte 2002 (aktuelles Jahr) existiert wenn ja dann soll er eine Arbeitsmappe drin speichern wenn nicht dann soll er den Ordner erzeugen und dann die Arbeitsmappe drin speichern.

Das Makro funktionniert aber nicht.
Was kann ich ändern oder wie kann ich das Problem ändern.

Danke im Voraus.
Steve


nach oben   nach unten

Re: Prüfen ob Pfad existiert wenn nicht erstellen
von: Rolf, Lgh.
Geschrieben am: 19.06.2002 - 18:31:50

Hallo Steve,
schau Dir das mal an:

'Text-Index: 181002 
'Thema: Datei 
'Betrifft: Vorhandensein von Verzeichnissen prüfen und _
Ordner anlegen 
'Excel-Version: XL 8/10 
'Frage: Es soll geprüft werden, ob ein Verzeichnis mit _
Unterverzeichnissen bereits besteht. Wenn ja, soll eine _
entsprechende Meldung erfolgen, wenn nein sollen sie erstellt _
werden. 
'Antwort: Den nachstehenden Code in ein Standardmodul _
eingeben, einer Schaltfläche zuweisen und starten. 
'Modul1:

Sub Pruefen()
   Dim arrOrdner As Variant
   Dim iOrdner As Integer
   Dim sDrive As String, sOrdner As String, sTmp As String
   sOrdner = InputBox("Zu erstellendes Verzeichnis:", , "c:\excel\neu")
   If sOrdner = "" Then Exit Sub
   If Right(sOrdner, 1) = "\" Then
      sOrdner = Left(sOrdner, Len(sOrdner) - 1)
   End If
   arrOrdner = fncFolders(sOrdner)
   For iOrdner = UBound(arrOrdner) To Step -1
      If fncIfFolderExists(CStr(arrOrdner(iOrdner))) Then
         MsgBox "Ordner " & arrOrdner(iOrdner) & " ist bereits vorhanden!"
      Else
         MkDir arrOrdner(iOrdner)
      End If
   Next iOrdner
End Sub

Private Function fncFolders(sFolder As String) As Variant
   Dim arr() As String
   Dim iCounter As Integer, iFolder As Integer
   ReDim arr(1 To 1)
   arr(1) = sFolder
   iFolder = 1
   For iCounter = Len(sFolder) To Step -1
      If Mid(sFolder, iCounter, 1) = "\" Or iCounter = 1 Then
         iFolder = iFolder + 1
         ReDim Preserve arr(1 To iFolder)
         arr(iFolder) = Left(sFolder, iCounter - 1)
      End If
   Next iCounter
   fncFolders = arr
End Function

Private Function fncIfFolderExists(sFolder As String) As Boolean
   Dim sOld As String
   sOld = CurDir
   On Error Resume Next
   ChDrive Left(sFolder, 1)
   ChDir sFolder
   If Err = 0 Then fncIfFolderExists = True
   On Error GoTo 0
   ChDrive Left(sOld, 1)
   ChDir sOld
End Function
 


Gruß Rolf
nach oben   nach unten

Re: Danke klappt hervorragend
von: Steve
Geschrieben am: 19.06.2002 - 20:13:45

Danke Rolf klapt hevorragend
Gruss
Steve

 nach oben

Beiträge aus den Excel-Beispielen zum Thema "Prüfen ob Pfad existiert wenn nicht erstellen"