Autmatisch Ordner erstellen

Autmatisch Ordner erstellen - Druckversion

+- Office-Fragen.de (https://office-fragen.de)
+-- Forum: Microsoft Office (https://office-fragen.de/forum-1.html)
+--- Forum: Excel (https://office-fragen.de/forum-2.html)
+--- Thema: Autmatisch Ordner erstellen (/thread-11854.html)

Autmatisch Ordner erstellen - skojo - 14.07.2020

Hallo liebes Forum,

gleich Vorweg bin kein Excel-Experte. Trotzdem habe ich es zusammengebracht das ich aus dem Excel automatisiert Ordner erstellen kann z.B. Ordernname (Zeile 1 + Zeile2).
Leider funktioniert es bei mir nicht wenn ich auf die entsprechende Spalte klicke das sich der Ordner öffnet...

Hier mein Code:

Option Explicit
Private Const basisPfad As String = "\\Pfad\"
Private Sub Worksheet_Change(ByVal Target As Range)
    Dim fso
    Dim pNr As String
    Dim pName As String
    Dim pbzl As String
    Dim folderName As String

    On Error GoTo fehler

    If Target.Cells.Count > 3 Then Exit Sub
    If Target.Row > 4 And Target.Column = 3 Or Target.Column = 4 Then
        pNr = Me.Cells(Target.Row, "C").Text
        pbzl = Me.Cells(Target.Row, "B").Text
        pName = Me.Cells(Target.Row, "D").Text
        If pNr <> "" And pName <> "" Then
            Set fso = CreateObject("Scripting.FileSystemObject")
            folderName = basisPfad & UCase(Left(pbzl, 2)) & "\"
            If Not fso.FolderExists(folderName) Then fso.createFolder folderName
            folderName = folderName & pNr & " " & pName & "\"
            If Not fso.FolderExists(folderName) Then fso.createFolder folderName
        End If
    End If
    Exit Sub

fehler:
    MsgBox "Fehler: " & Err.Description
End Sub
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    Dim wsh
    Dim pNr As String
    Dim pName As String
    Dim pbzl As String
    Dim folderName As String

    If Target.Column < 3 Then
        pNr = Me.Cells(Target.Row, "C").Text
        pName = Me.Cells(Target.Row, "D").Text
        Set wsh = CreateObject("WScript.Shell")
        folderName = basisPfad & UCase(Left(pbzl, 2)) & "\" & pNr & " " & pName & "\"
        wsh.Run """" & folderName & """"
    End If
End Sub

Es kommt dann diese Fehlermeldung:

Laufzeitfehler: -2147024894 ( 80070002)
Die Methode 'Run' für das Objekt IWshSehll3 ist fehlgeschlagen.

Ich hoffe mir kann jemand weiterhelfen...

RE: Autmatisch Ordner erstellen - thowe - 14.07.2020

Hallo -skojo

also bei läuft das Makro einwandfrei durch

RE: Autmatisch Ordner erstellen - skojo - 16.07.2020

(14.07.2020, 15:36)thowe schrieb: Hallo -skojo

also bei läuft das Makro einwandfrei durch

Bei mir leider nicht... Sad

RE: Autmatisch Ordner erstellen - Mase - 20.07.2020

Hi,

das WScript.Shell-Object brauchst Du in Deinem Fall nicht instanzieren.

Versuche anstelle:

Code:
Shell "Explorer.exe " & pfad, vbNormalFocus

RE: Autmatisch Ordner erstellen - skojo - 21.07.2020

(20.07.2020, 16:28)Mase schrieb: Hi,

das WScript.Shell-Object brauchst Du in Deinem Fall nicht instanzieren.

Versuche anstelle:

Code:
Shell "Explorer.exe " & pfad, vbNormalFocus

Hallo Marco,

danke. Aber wo füge ich das ein?

Shell "Explorer.exe " & pfad, vbNormalFocus

LG

RE: Autmatisch Ordner erstellen - Mase - 21.07.2020

Anstelle:

Code:
wsh.Run """" & folderName & """"

Zusammengefasst also so:

Code:
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)

    Dim pNr As String

    Dim pName As String

    Dim pbzl As String

    Dim folderName As String

    If Target.Column < 3 Then

        pNr = Me.Cells(Target.Row, "C").Text

        pName = Me.Cells(Target.Row, "D").Text

        folderName = basisPfad & UCase(Left(pbzl, 2)) & "\" & pNr & " " & pName & "\"

        Shell "Explorer.exe " & folderName, vbNormalFocus

    End If

End Sub