Excel VBA

[Ger_17]

Hallo Leute!

Ich hab ein kleines Problem mit diesem Code:

Sub Schaltfläche6_Klicken()
  Dim i As Integer
  Dim sPfad As String
  Dim fso, Ordnername
  Set fso = CreateObject("Scripting.FileSystemObject")
   'Prüfen ob Ordner 'daten' existiert. Wenn nicht, neu anlegen
  If Len(Dir("c:\Firma", vbDirectory)) = 0 Then MkDir "c:\Firma"
  For i = 3 To 1000
    sPfad = Cells(i, 7).Value & " " & Cells(i, 6).Value
    Ordnername = Cells(i, 7).Value & " " & Cells(i, 6).Value
    If (fso.FolderExists(Ordnername)) = False Then
    MkDir ("c:\Firma\" & sPfad)
    Else
    On Error Resume Next
End If
Next
End Sub

Zuerst soll geprüft werden ob es den Ordner C:\Firma gibt, wenn ja weiter, sonst anlegen und dann soll er prüfen ob die Ordner (Spalte 6 und 7 sind Nachname und Vorname) der jeweiligen Kunden schon angelegt worden sind. Wenn ja weiter, sonst anlegen.

Jetzt gibt es den Ordner schon dennoch springt mit Excel in die Zeile

MkDir ("c:\Firma\" & sPfad)

ich versteh nicht warum.

Bitte um Unterstützung.
Danke!

[wbendl]

Hi!

Zuerst solltest du etwas Ordnung in den Code bringen. Dann ist er leichter zu verstehen, und Fehler sind leichter zu erkennen.

Ich würde sagen die Variable Ordnername enthält keinen gültigen Pfad.


mfg

WB

[Ger_17]

danke, ja hat gestimmt ... ein kollege hat mir zeitgleich den Fehler gezeigt

hier ist der richtige code:

Sub Schaltfläche6_Klicken()
  Dim i As Integer
  Dim sPfad As String
  Dim fso, Ordnername
  Set fso = CreateObject("Scripting.FileSystemObject")
   'Prüfen ob Ordner 'daten' existiert. Wenn nicht, neu anlegen
    If Len(Dir("c:\Firma", vbDirectory)) = 0 Then
        MkDir "C:\Firma"
    Else
    'do nothing
    End If
        For i = 3 To 1000
            sPfad = Cells(i, 7).Value & " " & Cells(i, 6).Value
            Ordnername = Cells(i, 7).Value & " " & Cells(i, 6).Value
                If sPfad = "" Then
                Else
                    If (fso.FolderExists("C:\Firma\" & Ordnername)) = False Then
                        MkDir ("C:\Firma\" & sPfad)
                    Else
                        On Error Resume Next
                    End If
                End If
    Next
    End Sub

*closed*

[FranzK]

Hi

Na ja, "richtiger Code" ist hier wohl ein wenig übertrieben. Eine erste Verbesserung wäre:

Public Sub Schaltfläche6_Klicken()

  Dim i As Integer
  Dim RootDir As String
  Dim NewDir As String
  Dim Ordnername As String
  Dim fso

  RootDir = "C:\Firma"
  Set fso = CreateObject("Scripting.FileSystemObject")

  'Prüfen ob Ordner 'daten' existiert. Wenn nicht, neu anlegen
  If Len(Dir(RootDir, vbDirectory)) = 0 Then
    MkDir RootDir
  End If
    
  'Jetzt das Ganze für die Unterordner
  For i = 3 To 1000
    Ordnername = Cells(i, 7).Value & " " & Cells(i, 6).Value
    If Trim$(Ordnername) <> "" Then  
      NewDir = RootDir & "\" & Ordnername
      If (fso.FolderExists(NewDir)) = False Then
        MkDir (NewDir)
      End If
    End If
  Next

End Sub

[Ger_17]

@FranzK
Thx ... verstehe zwar nicht alle optimierungen, aber das ist ja nicht so tragisch hauptsache der code funktioniert.

habe ihn für mich angepasst und funzt super.

[FranzK]

Zitat von Ger_17

@FranzK
Thx ... verstehe zwar nicht alle optimierungen, aber das ist ja nicht so tragisch hauptsache der code funktioniert.

habe ihn für mich angepasst und funzt super.

Dir ist aber schon bewusst, dass die Abfrage If sPfad ="" völlig sinnlos ist, da sPfad ja immer zumindest ein Leerzeichen beinhaltet? Dein Ursprünglicher Code sucht bis zu 1000 Mal sinnlos nach einem Verzeichnis und lebt nur von der Toleranz von Windows, dass es sich nicht daran stört, wenn am Ende eines Verzeichnisnamens noch ein insignifikantes Leerzeichen steht...

[Ger_17]

stimmt ... klingt logisch