Verzeichnisse / Dateien öffnen und schliessen in VBA

Hallo,

viel einfacher.

1. Wenn ich Verzeichnisse und Dateien angelegt habe, möchte ich, dass er wenn ich das Modul ein zweites starte, er es erkennt.

Denn ich bekomme natürlich eine Fehlermeldung wenn das Verzeichnis schon angelegt ist.

In Pascal wird es über die "if then else" abgefangen.

Ich habe da was gefunden.

If (MyDir, vbDirectory) = "" Then

MkDir MyDir

End if

So in etwa müsste es sein.

M.f.G.

B.M.

Hallo,

Sub Verz()

Dim test As String

If Dir(VBA.Environ$("UserProfile") & "\Desktop\test", vbDirectory) = "" Then

MkDir VBA.Environ$("UserProfile") & "\Desktop\test"

End If

End Sub

Hab die Lösung, er erkennt selber, ob ein Verzeichnis vorhanden ist.

Vielen Dank

B.M.

ich benötige die Abfangungen für angelegte Ordner und Dateien.

Was bitte soll das sein? Ich rate mal...

Andreas.

#Const Develop = True

Private Sub Example_FolderCreate()

  Dim Data, Index, This

  Dim i As Long

  Dim Folder As String

  'Read in all values

  Data = Range("A1").CurrentRegion.Value

  'Create a row pointer for each column

  ReDim Index(1 To UBound(Data, 2))

  'Create an array for the folder items

  ReDim This(0 To UBound(Data, 2))

  'Main path

  This(0) = ThisWorkbook.Path

  

  'Initialize

  For i = 1 To UBound(Data, 2)

    Index(i) = 1

  Next

  

  Do

    'Copy the items into our array

    For i = 1 To UBound(Data, 2)

      This(i) = Data(Index(i), i)

    Next

    'Create the path

    Folder = Join(This, "\")

#If Develop Then

    Debug.Print Folder

#Else

    'Create it on disk

    If Not FolderCreate(Folder) Then

      MsgBox Folder, vbCritical, "Can not create:"

      Exit Sub

    End If

#End If

    'Find next item

    i = UBound(Data, 2)

    Do

      'Last row?

      If Index(i) = UBound(Data) Then

EndRow:

        'Start this column again from first row

        Index(i) = 1

        'Go one column left

        i = i - 1

        'Done?

        If i < 1 Then Exit Sub

      Else

        'Next row

        Index(i) = Index(i) + 1

        'Empty?

        If IsEmpty(Data(Index(i), i)) Then

          'Start over

          GoTo EndRow

        Else

          'Create this one in the next round

          Exit Do

        End If

      End If

    Loop

  Loop

End Sub

Function FolderCreate(ByVal Path As String) As Boolean

  'Creates a complete sub directory structure

  Dim Temp, i As Integer

  On Error GoTo ExitPoint

  If Dir(Path, vbDirectory) = "" Then

    If Right$(Path, 1) = "\" Then Path = Left$(Path, Len(Path) - 1)

    If Left$(Path, 2) = "\\" Then

      i = InStr(3, Path, "\")

      Temp = Split(Mid$(Path, i + 1), "\")

      Temp(0) = Left$(Path, i) & Temp(0)

    Else

      Temp = Split(Path, "\")

    End If

    Path = ""

    For i = 0 To UBound(Temp)

      Path = Path & Temp(i) & "\"

      If Dir(Path, vbDirectory) = "" Then MkDir Path

    Next

  End If

  FolderCreate = True

ExitPoint:

End Function

Function FolderDelete(ByVal Path As String) As Boolean

  'Deletes a complete sub directory structure

  Dim This As String

  Dim Temp, i As Integer

  On Error GoTo ExitPoint

  If Right$(Path, 1) <> "\" Then Path = Path & "\"

  This = Path

  Do

    Do

      If Dir(This & "*.*") <> "" Then Kill This & "*.*"

      Temp = Dir(This, vbDirectory)

      Do While Temp = "." Or Temp = ".."

        Temp = Dir

      Loop

      If Temp = "" Then

        Exit Do

      Else

        This = This & Temp & "\"

      End If

    Loop

    RmDir This

    If This = Path Then

      Exit Do

    Else

      Temp = Split(This, "\")

      ReDim Preserve Temp(0 To UBound(Temp) - 1)

      Temp(UBound(Temp)) = ""

      This = Join(Temp, "\")

    End If

  Loop

  FolderDelete = True

ExitPoint:

End Function

Die Vorlage ist schon okay, die Frage wäre wie Du das so hinbekommen hast...

Egal, öffne die Vorlage erneut

Klicke mit der rechten Maustaste auf die Blattregisterkarte

Wähle "Code anzeigen"

STRG-A, STRG-C

VBA-Editor schließen

Vorlage schließen

Öffne Deine Datei

Klicke mit der rechten Maustaste auf die Blattregisterkarte

Wähle "Code anzeigen"

STRG-V

VBA-Editor schließen

Datei speichern

Teste das Verhalten

Excel zu

Excel auf

Öffne Deine Datei

Teste das Verhalten

Alles gut?

Andreas.

Hallo Claus,
<br />wie schon gesagt ist das komplettes Neuland für mich.
<br />Wann muss ich denn dann den VBA Code eingeben?
<br />Sobald ich diesen eingegeben habe, ist die Mappe ja automatisch auch blattgeschützt.
<br />meine Vorgehensweise lautet aktuell grob wie folgt.
<br />Ich habe meine Datei ohne VBA Code, ohne Blattschutz, ohne Freigabe
<br />Ich öffen den VB Editor - klicke links auf "Diese Arbeitsmappe" und gebe unter den Kategorien "Workbook" und "Open" deinen VBA Code ein.
<br />Wenn ich den Editor schließe, ist die Mappe schreibgeschützt.
<br />Anschließend aktiviere ich "Arbeitsmappe freigeben".
<br />Auch wenn ich den Blattschutz durch den VBA Code rausnehme und das gleiche nochmal manuell über "Blatt schützen" mache (mit Haken bei Autofilter und Sortierung) und anschließend freigebe, funktioniert es leider nicht. Bzw nur so lange, wie ich die Datei nicht schließe und wieder öffne.
<br />Für mich als Laien klingt das so, als würde der Code generell funktionieren aber beim erneuten Öffnen der Datei nicht richtig gestartet.
<br />Gruß
<br />Daniel
<br />