Ordner anlegen / suchen

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Hallo
Vielleicht hilft dir folgender Code weiter.

' Unter Extras\Verweise ... muß "Microsoft Scripting Runtime"
' aktiviert werden

Sub Ordner_löschen()
Call DeleteFolder("C:\Temp\Temp")
End Sub
Sub Ordner_erstellen()
Call CreateFolder("C:\Temp\Temp")
End Sub
Public Sub DeleteFolder(sFolder As String)
Dim fso     As New FileSystemObject
Dim Text    As String
Dim Antwort
ChDir "C:\"
Text = "Wollen Sie den Ordner  " & sFolder & vbCrLf & _
       "wirklich löschen?" & vbCrLf & vbCrLf & _
       "Alle darin befindlichen Dateien gehen verloren."
On Error GoTo DeleteFolder_ERROR
If fso.folderexists(sFolder) Then
Antwort = MsgBox(Text, vbCritical & vbOKOnly, "Ordner löschen")
    If Antwort = 1 Then
        fso.DeleteFolder (sFolder)
    Else
        MsgBox "Es wurde kein Ordner gelöscht."
    End If
Else
    Err.Raise 10001, "Verzeichnis existiert nicht"
End If
Exit Sub
DeleteFolder_ERROR:
MsgBox Err.Description
End Sub
Sub CreateFolder(sFolder As String)
Dim fso     As New FileSystemObject
Dim Antwort
On Error GoTo ErrorFolder_ERROR
If fso.folderexists(sFolder) Then
Antwort = MsgBox("Ordner  " & sFolder & "  existiert schon. Wollen" & vbCrLf & _
                 "Sie diesen löschen und dann neu erstellen?" _
                 , vbYesNo + vbCritical, "Ordner löschen und neu anlegen")
    If Antwort = 6 Then
        fso.DeleteFolder (sFolder)
        fso.CreateFolder (sFolder)
    Else
        Exit Sub
    End If
Else
        fso.CreateFolder (sFolder)
End If
Exit Sub
ErrorFolder_ERROR:
MsgBox Err.Description
mfg, GraFri

Hallo
Vielleicht hilft dir folgender Code weiter.

' In ein Modul
' Hier alle benötigten API-Funktionen
Private Const MAX_PATH = 260
Private Const INVALID_HANDLE_VALUE = -1
Private Const FiLE_ATTRIBUTE_DIRECTORY = &H10
Private Type FileTime
  dwLowDateTime As Long
  dwHighDateTime As Long
End Type
Private Type WIN32_FIND_DATA
  dwFileAttributes As Long
  ftCreateionTime As FileTime
  ftLastAccessTime As FileTime
  ftLastWriteTime As FileTime
  nFileSizeHigh As Long
  nFileSizeLow As Long
  dwReserved0 As Long
  dwReserved1 As Long
  cFileName As String * MAX_PATH
  cAlternate As String * 14
End Type
Private Declare Function FindFirstFile Lib "kernel32" Alias _
  "FindFirstFileA" (ByVal lpFileName As String, _
  lpFindFileData As WIN32_FIND_DATA) As Long
Private Declare Function FindClose Lib "kernel32" _
  (ByVal hWndFile As Long) As Long
'Die nachfolgende Funktion prüft, ob das angegebene Verzeichnis
'existiert und gibt im Erfolgsfall den Wert True zurück.
'Existiert das Verzeichnis nicht, wird False zurückgegeben.
Sub Ordner_vorhanden()
  If OrdnerVorhanden("C:\TEMP") = True Then
    MsgBox "Ordner vorhanden"
  Else
    MsgBox "Ordner nicht vorhanden"
  End If

End Sub
Public Function OrdnerVorhanden(ByVal sFolder As String) As Boolean
Dim hFile As Long
Dim WFD As WIN32_FIND_DATA

  'Der Parameter sFolder enthält das zu prüfende Verzeichnis
  sFolder = Trim$(sFolder)
  If Right$(sFolder, 1) = "\" Then
    sFolder = Left$(sFolder, Len(sFolder) - 1)
  End If
  hFile = FindFirstFile(sFolder, WFD)
  OrdnerVorhanden = (hFile <> INVALID_HANDLE_VALUE) And _
    (WFD.dwFileAttributes And FiLE_ATTRIBUTE_DIRECTORY)
  Call FindClose(hFile)
End Function
Bei weiteren Fragen einfach melden.
mfg, GraFri

Beliebteste Forumthreads (12 Monate)

3
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Ordner anlegen / suchen

3 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

3
Beiträge zum Forumthread

Beiträge zu diesem Forumthread