14.07.2020, 12:38
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...
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...