WCM Forum - Excel VBA

WCM Forum (http://www.wcm.at/forum/index.php)

- Programmierung (http://www.wcm.at/forum/forumdisplay.php?f=17)

- - Excel VBA (http://www.wcm.at/forum/showthread.php?t=239891)

Hallo Leute!

Ich hab ein kleines Problem mit diesem Code:

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

Code:

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

ich versteh nicht warum.

Bitte um Unterstützung.
Danke!
:bier:

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

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

hier ist der richtige code:

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*

Hi

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

Code:

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

:hallo:

@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.

:bier:

Zitat:

Zitat von Ger_17 (Beitrag 2424717)

@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...

:hallo:

stimmt ... klingt logisch

:hallo: