Hallo zusammen,
Das nachfolgende Makro sucht im Verzeichnis
„X:\dir1\dir2\dir3\100___“
Private Sub Worksheet\_SelectionChange(ByVal Target As Range)
If Target.Column = 1 And Target.Row \> 1 And Not IsEmpty(Target) Then
Verzeichnis = "X:\dir1\dir2\dir3\100\_\_\_"
Workbooks.Open FileName:=Verzeichnis & "\" & Target.Value
End If
Rows.Interior.ColorIndex = xlColorIndexNone
Rows(Target.Row).Interior.ColorIndex = 6
End Sub
Ist es möglich, Excel zusätzlich in anderen Verzeichnissen suchen zu lassen ? z.B
„X:\dir1\dir2\dir3\200___“ und
„X:\dir1\dir2\dir3\300___“ und
„X:\dir1\dir2\dir3\400___“ und
…
XL2003 + 2010
Gruß und danke
Rolf
Ist es möglich, Excel zusätzlich in anderen Verzeichnissen
suchen zu lassen ? z.B
„X:\dir1\dir2\dir3\200___“ und
„X:\dir1\dir2\dir3\300___“ und
„X:\dir1\dir2\dir3\400___“ und
Hallo Rolf,
ungetestet:
Private Sub Worksheet\_SelectionChange(ByVal Target As Range)
Dim N As Integer, Vorh As Integer, V As Integer
If Target.Column = 1 And Target.Row \> 1 And Not IsEmpty(Target) Then
For N = 1 To 4
If Dir("X:\dir1\dir2\dir3\" & N & "00\_\_\_\" & Target.Value) "" Then
Vorh = Vorh + 1
V = N
End If
Next N
Select Case Vorh
Case 0
MsgBox "Datei nicht gefunden: " & Target.Value
Case 1
Workbooks.Open Filename:="X:\dir1\dir2\dir3\" & V & "00\_\_\_\" & Target.Value
Case Else
MsgBox "Datei " & Vorh & "-fach gefunden: " & Target.Value
End Select
End If
Rows.Interior.ColorIndex = xlColorIndexNone
Rows(Target.Row).Interior.ColorIndex = 6
End Sub
Gruß
Reinhard
ungetestet:
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim N As Integer, Vorh As Integer, V As Integer
If Target.Column = 1 And Target.Row > 1 And Not
IsEmpty(Target) Then
For N = 1 To 4
If Dir(„X:\dir1\dir2\dir3“ & N & „00___“ & Target.Value)
„“ Then
Vorh = Vorh + 1
V = N
End If
Next N
Select Case Vorh
Case 0
MsgBox "Datei nicht gefunden: " & Target.Value
Case 1
Workbooks.Open Filename:=„X:\dir1\dir2\dir3“ & V & „00___“ &
Target.Value
Case Else
MsgBox "Datei " & Vorh & "-fach gefunden: " & Target.Value
End Select
End If
Rows.Interior.ColorIndex = xlColorIndexNone
Rows(Target.Row).Interior.ColorIndex = 6
End Sub
Moin Reinhard,
da war mein Beispiel etwas zu unpräzise - sorry.
die Unterverzeichnisse kann ich im Skript sicher umbenennen, aber
die letzten Verzeichnisse heissen real
X:\dir1\dir2\dir3\26\_\_\_
X:\dir1\dir2\dir3\27\_\_\_
X:\dir1\dir2\dir3\28\_\_\_
X:\dir1\dir2\dir3\98\_\_\_
X:\dir1\dir2\dir3\2000-2599
Habe versucht, das umzustellen, krieg ich aber nicht hin 
Kannst Du bitte nochmal helfen?
Gruß
Rolf
X:\dir1\dir2\dir3\26___
X:\dir1\dir2\dir3\27___
X:\dir1\dir2\dir3\28___
X:\dir1\dir2\dir3\98___
X:\dir1\dir2\dir3\2000-2599
Hallo Rolf,
ungetestet:
Option Explicit
Private Sub Worksheet\_SelectionChange(ByVal Target As Range)
Dim N As Integer, Vorh As Integer, V As Integer, Pfade
If Target.Column = 1 And Target.Row \> 1 And Not IsEmpty(Target) Then
Pfade = Array("26\_\_\_\", "27\_\_\_\", "28\_\_\_\", "98\_\_\_\", "2000-2599\")
For N = LBound(Pfade) To UBound(Pfade)
If Dir("X:\dir1\dir2\dir3\" & Pfade(N) & Target.Value) "" Then
Vorh = Vorh + 1
V = N
End If
Next N
Select Case Vorh
Case 0
MsgBox "Datei nicht gefunden: " & Target.Value
Case 1
Workbooks.Open Filename:="X:\dir1\dir2\dir3\" & Pfade(V) & Target.Value
Case Else
MsgBox "Datei " & Vorh & "-fach gefunden: " & Target.Value
End Select
End If
Rows.Interior.ColorIndex = xlColorIndexNone
Rows(Target.Row).Interior.ColorIndex = 6
End Sub
Gruß
Reinhard
1 „Gefällt mir“
Danke
Hallo Reinhard,
vielen Dank für Deine Mühe. Klappt bestens.
Gruß und schönes Wochenende
Rolf
Nachgefragt
Moin Reinhard,
da ist jetzt eine Zeile abhanden gekommen, die ich noch benötige:
Workbooks.Open FileName:=Verzeichnis & "\" & Target.Value
In Spalte A meiner Arbeitsmappe stehen Dateinamen, z.B 2757.00.11.xls
(Ich weiß, ein Dateiname sollte nur EINEN Punkt haben, aber da kann ich nix machen.)
Bei Klick auf den Dateinamen soll er die entsprechende Datei öffnen, die sich in einem der genannten Verzeichnisse befindet.
Hab’s schon mit Deiner Sytax versucht, klappt aber nicht.
Könntest Du nochmal ein Auge drauf werfen?
Gruß
Rolf
Option Explicit
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim N As Integer, Vorh As Integer, V As Integer, Pfade
If Target.Column = 1 And Target.Row > 1 And Not
IsEmpty(Target) Then
Pfade = Array(„26___“, „27___“, „28___“, „98___“,
„2000-2599“)
For N = LBound(Pfade) To UBound(Pfade)
If Dir(„X:\dir1\dir2\dir3“ & Pfade(N) & Target.Value) „“
Then
Vorh = Vorh + 1
V = N
End If
Next N
Select Case Vorh
Case 0
MsgBox "Datei nicht gefunden: " & Target.Value
Case 1
Workbooks.Open Filename:=„X:\dir1\dir2\dir3“ & Pfade(V) &
Target.Value
Case Else
MsgBox "Datei " & Vorh & "-fach gefunden: " & Target.Value
End Select
End If
Rows.Interior.ColorIndex = xlColorIndexNone
Rows(Target.Row).Interior.ColorIndex = 6
End Sub
Gruß
Reinhard
Hallo Rolf,
da ist jetzt eine Zeile abhanden gekommen, die ich noch
benötige:
Workbooks.Open FileName:=Verzeichnis & „“ & Target.Value
wer hat die denn geklaut? Die steht doch prinzipiell im Code.
In Spalte A meiner Arbeitsmappe stehen Dateinamen, z.B
2757.00.11.xls
(Ich weiß, ein Dateiname sollte nur EINEN Punkt haben, aber da
kann ich nix machen.)
Tja nun, ich fand die alte 8.3 Regel gut. Da mußten sich die User
Gedanken machen über Dateinamen und Ordnerstrukturen.
Und auch heutzutage können nicht alle Programme die man doch mal
braucht mit Leerzeichen, Sonderzeichen wie ä.ü,ö u,ä, umgehen.
Aber (immer noch ungetestet) müßte es doch meinem Code Schnuppe sein
wenn da zwei Punkte sind.
Bei Klick auf den Dateinamen soll er die entsprechende Datei
öffnen, die sich in einem der genannten Verzeichnisse
befindet.
Hab’s schon mit Deiner Sytax versucht, klappt aber nicht.
Was genau geschieht da bzw. was geschieht nicht?
Beispielmappe hochladen!? Mit Originalnamen.
Oder heißen die Pfade etwa echt x:\dir1\dir2\dir3?
Könntest Du nochmal ein Auge drauf werfen?
Wenn ich mal 'nen Augenblick Zeit habe *grien*
Gruß
Reinhard
Hallo Reinhard,
Was genau geschieht da bzw. was geschieht nicht?
Was bisher funktionierte:
In Spalte A meiner Arbeitsmappe stehen Dateinamen, z.B
A
1
2
3
4 2757.00.11.xls
5 2759.01.11.xls
6 2763.02.11.xls
Bei Klick auf den Dateinamen öffnete er die entsprechende Datei
die im Verzeichnis X:\Info\Allgemein\Anlagenwichte\27___ liegt, weil im
code in Tabelle 1 das Verzeichnis hinterlegt ist:
Private Sub Worksheet\_SelectionChange(ByVal Target As Range)
If Target.Column = 1 And Target.Row \> 1 And Not IsEmpty(Target) Then
**Verzeichnis = "X:\Info\Allgemein\Anlagenwichte\27\_\_\_"**
Workbooks.Open FileName:=Verzeichnis & "\" & Target.Value
End If
Er soll aber auch Dateien finden die in einem der anderen Verzeichnisse liegen z.B.
2836.01.11 im Verzeichnis X:\Info\Allgemein\Anlagenwichte\28___
Tut er aber nicht, sondern bringt die Meldung:
Datei nicht gefunden: 2836.01.11.xls.
Beispielmappe hochladen!? Mit Originalnamen.
Geht nicht, zu betriebsspezifisch, auch im code.
Oder heißen die Pfade etwa echt x:\dir1\dir2\dir3?
Nein, die Verzeichnisnamen lauten:
X:\Info\Allgemein\Anlagenwichte\2000-2599
X:\Info\Allgemein\Anlagenwichte\98___
X:\Info\Allgemein\Anlagenwichte\26___
X:\Info\Allgemein\Anlagenwichte\27___
X:\Info\Allgemein\Anlagenwichte\28___
Gruß
Rolf
Er soll aber auch Dateien finden die in einem der anderen
Verzeichnisse liegen z.B.
2836.01.11 im Verzeichnis
X:\Info\Allgemein\Anlagenwichte\28___
Tut er aber nicht, sondern bringt die Meldung:
Datei nicht gefunden: 2836.01.11.xls.
Hallo Rolf,
warum nimmst du nicht meinen Code?
Option Explicit
Private Sub Worksheet\_SelectionChange(ByVal Target As Range)
Dim N As Integer, Vorh As Integer, V As Integer, Pfade
If Target.Column = 1 And Target.Row \> 1 And Not IsEmpty(Target) Then
Pfade = Array("26\_\_\_\", "27\_\_\_\", "28\_\_\_\", "98\_\_\_\", "2000-2599\")
For N = LBound(Pfade) To UBound(Pfade)
If Dir("X:\Info\Allgemein\Anlagenwichte\" & Pfade(N) & Target.Value) "" Then
Vorh = Vorh + 1
V = N
End If
Next N
Select Case Vorh
Case 0
MsgBox "Datei nicht gefunden: " & Target.Value
Case 1
Workbooks.Open Filename:="X:\Info\Allgemein\Anlagenwichte\" & Pfade(V) & Target.Value
Case Else
MsgBox "Datei " & Vorh & "-fach gefunden: " & Target.Value
End Select
End If
Rows.Interior.ColorIndex = xlColorIndexNone
Rows(Target.Row).Interior.ColorIndex = 6
End Sub
Gruß
Reinhard
Danke 
Hallo Reinhard,
der code stand bereits drin, hat dropsdem nicht geklappt.
Jede Zeile verglichen, stand genau das Selbe drin.
Code noch einmal reinkopiert - läuft. *nixverstehn*
Danke für Deine Mühe.
Hast mir (mal wieder) sehr geholfen.
Gruß
Rolf