Hi Stefan,
Ja, Dateipfad habe ich zweimal eingefügt, bzw. beim ersten mal inkl. exaktem Pfad zur Datei.
Sorry, falls das mit den Dateinamen verwirrend war, darauf habe ich grade nicht geachtet...Dateien sind aber wie im Eingangsthread benannt.
Hier der Code wie von mir "angepasst":
Sub prcX()
Dim strDatei As String, strLieferant As String, strSachnummer As String
'On Error Resume Next
'im Unterverzeichnis Dateien bitte anpassen
strDatei = Dir(ThisWorkbook.Path & "Z:\...\...\...\...\...\...\...\Angebot_Lieferant1_Sachnummer1.xlsx")
Do While strDatei <> ""
Workbooks.Open ThisWorkbook.Path & "Z:\...\...\...\...\...\...\...\...\...\" & strDatei
strLieferant = Split(strDatei, "_")(1)
strSachnummer = Split(strDatei, "_")(2)
strSachnummer = Left(strSachnummer, InStr(1, strSachnummer, ".") - 1)
MsgBox "Die Sachnummer " & strSachnummer & " von dem Lieferanten " & _
strLieferant & " existiert " & IIf(WorkSheetExists(strSachnummer), "", "nicht ") _
& " als Tabellenblatt."
ActiveWorkbook.Close False
strDatei = Dir()
Loop
End Sub
Public Function WorkSheetExists(ByVal strName As String) As Boolean
'On Error Resume Next
WorkSheetExists = Not ThisWorkbook.Worksheets(strName) Is Nothing
End Function
Beide "on Error resume next" sind aus-kommentiert (habe zuvor auch nur den ersten aus-kommentiert -> kein Unterschied).
Beide Dateipfade führen in denselben Ordner (ersterer lediglich zur exakten Datei) -> Liegt hier der Fehler?
Hallo Philipp,
wenn ich mich jetzt genau auf deine Angaben von hier festlege
(22.10.2018, 08:54)Philipp1344 schrieb: [ -> ]Struktur sieht so aus:
... Überordner >> Vergleichsdatei.xlsm
>> Angebotsordner >> Angebot 1.xls*
>> Angebot 2.xls*
>> Angebot n.xls*
dann müssen die Pfadangaben so lauten
PHP-Code:
Sub prcX()
Dim strDatei As String, strLieferant As String, strSachnummer As String
'On Error Resume Next
'im Unterverzeichnis Dateien bitte anpassen
strDatei = Dir(ThisWorkbook.Path & "\Angebotsordner\*.xls*")
Do While strDatei <> ""
Workbooks.Open ThisWorkbook.Path & "\Angebotsordner\" & strDatei
strLieferant = Split(strDatei, "_")(1)
strSachnummer = Split(strDatei, "_")(2)
strSachnummer = Left(strSachnummer, InStr(1, strSachnummer, ".") - 1)
MsgBox "Die Sachnummer " & strSachnummer & " von dem Lieferanten " & _
strLieferant & " existiert " & IIf(WorkSheetExists(strSachnummer), "", "nicht ") _
& " als Tabellenblatt."
ActiveWorkbook.Close False
strDatei = Dir()
Loop
End Sub
Public Function WorkSheetExists(ByVal strName As String) As Boolean
On Error Resume Next
WorkSheetExists = Not ThisWorkbook.Worksheets(strName) Is Nothing
End Function
Hallo Stefan
...also erstmal super, wie schnell du immer antwortest - Danke!
Leider ändert sich am Fehler "Datei nicht gefunden" nach wie vor nichts.
Vielleicht sitzt das Problem wie so oft auch vor dem Bildschirm...
Hallo,
dann passen die Pfade nicht. Ein letzte Hilfe von mir.
Gehe in deine Datei, in der das Makro ist
- Gehe in deine Datei, in der das Makro ist
- rufe den VBA-Editor auf
- lass dir dort mit der Tastenkombination Strg + G das Direktfenster anzeigen
- gebe in diesem ?ThisWorkbook.Path ein und drücke die Return-Taste
- merke dir was das zurückgegeben wird
- mache dasselbe mit irgendeiner Angebotsdatei.
Wie sehen jetzt beide Pfade aus?
Pfad Vergleichsdatei (Zieldatei):
\\...\H01$\Benutzer\Data\My Documents
Pfad Zieldatei:
\\...\H01$\Benutzer\Data\My Documents\Angebote
...absolut identisch bis zum letzten Unterordner
(die ... habe ich hier eingefügt, um nicht firmeninterne Verzeichnisstrukturen preiszugeben)
Hallo Philipp,
(22.10.2018, 12:33)Philipp1344 schrieb: [ -> ](die ... habe ich hier eingefügt, um nicht firmeninterne Verzeichnisstrukturen preiszugeben)
schon klar, du hast aber schon das letzte Verzeichnis vom meinen vermeintlichen 'Angebotsordner' auf den tatsächlichen 'Angebote' abgeändert
Ja habe ich
...seitdem ich das ganze nun unter meinem lokalen Laufwerk speichere, passiert wieder ....exakt nichts..(bei Klick auf Button/Auslösen des Makros)
Code:
Sub prcX()
Dim strDatei As String, strLieferant As String, strSachnummer As String
'On Error Resume Next
'im Unterverzeichnis Dateien bitte anpassen
strDatei = Dir(ThisWorkbook.Path & "\...\H01$\Benutzer\Data\My Documents\*.xls*")
Do While strDatei <> ""
Workbooks.Open ThisWorkbook.Path & "\...\H01$\Benutzer\Data\My Documents\Angebote\" & strDatei
strLieferant = Split(strDatei, "_")(1)
strSachnummer = Split(strDatei, "_")(2)
strSachnummer = Left(strSachnummer, InStr(1, strSachnummer, ".") - 1)
MsgBox "Die Sachnummer " & strSachnummer & " von dem Lieferanten " & _
strLieferant & " existiert " & IIf(WorkSheetExists(strSachnummer), "", "nicht ") _
& " als Tabellenblatt."
ActiveWorkbook.Close False
strDatei = Dir()
Loop
End Sub
Public Function WorkSheetExists(ByVal strName As String) As Boolean
'On Error Resume Next
WorkSheetExists = Not ThisWorkbook.Worksheets(strName) Is Nothing
End Function
Hätte nicht gedacht, dass es bereits daran scheitert...
Hallo Philipp,
ist ja auch klar, wenn Du das immer falsch übernimmst
Erinnerst Du dich noch, was als Pfad zurückgegeben wurde? Und Du verbindest das dann nochmal mit einer starren Pfadangeabe.
Code:
Sub prcX()
Dim strDatei As String, strLieferant As String, strSachnummer As String
'On Error Resume Next
'im Unterverzeichnis Dateien bitte anpassen
strDatei = Dir(ThisWorkbook.Path & "\Angebote\*.xls*")
Do While strDatei <> ""
Workbooks.Open ThisWorkbook.Path & "\Angebote\" & strDatei
strLieferant = Split(strDatei, "_")(1)
strSachnummer = Split(strDatei, "_")(2)
strSachnummer = Left(strSachnummer, InStr(1, strSachnummer, ".") - 1)
MsgBox "Die Sachnummer " & strSachnummer & " von dem Lieferanten " & _
strLieferant & " existiert " & IIf(WorkSheetExists(strSachnummer), "", "nicht ") _
& " als Tabellenblatt."
ActiveWorkbook.Close False
strDatei = Dir()
Loop
End Sub
Public Function WorkSheetExists(ByVal strName As String) As Boolean
On Error Resume Next
WorkSheetExists = Not ThisWorkbook.Worksheets(strName) Is Nothing
End Function
Okay, Fehler gefunden und korrigiert. Bei Klick auf meinen Button wird nun eine meiner Angebotsdateien geöffnet (Angebot_Lieferant1_Sachnummer1.xlsx), die weiteren Angebotsdateien (...Lieferant2_Sachnummer1, ...Lieferant3_Sachnummer1 etc) jedoch nicht. Nach Öffnen der Angebotsdatei erscheint zudem das Info-Fenster "Index außerhalb des gültigen Bereichs". (?????)
Außerdem wäre es jetzt noch extrem nützlich, wenn die ausgewählten Zellbereiche der Angebotsdateien (jeweils E19:E74) durch eben jenen Button dann in meine Zieldatei (in der sich der Button befindet) eingepflegt werden, nach folgendem Schema:
Lieferant1_Sachnummer1: Werte aus E19:E74 in Zieldatei E4:E60
Lieferant2_Sachnummer1: Werte aus E19:E74 in Zieldatei H4:H60
Lieferant3_Sachnummer1: Werte aus E19:E74 in Zieldatei L4:L60
... und so weiter (weitere Lieferanten-Daten jeweils im Abstand von 3 Spalten hinzufügen)
Vielleicht wurde das aus meinem Eingangsthread nicht ganz klar.
Code:
Sub prcX()
Dim strDatei As String, strLieferant As String, strSachnummer As String
'On Error Resume Next
'im Unterverzeichnis Dateien bitte anpassen
strDatei = Dir(ThisWorkbook.Path & "\Angebote\*.xls*")
Do While strDatei <> ""
Workbooks.Open ThisWorkbook.Path & "\Angebote\" & strDatei
strLieferant = Split(strDatei, "_")(1)
strSachnummer = Split(strDatei, "_")(2)
strSachnummer = Left(strSachnummer, InStr(1, strSachnummer, ".") - 1)
MsgBox "Die Sachnummer " & strSachnummer & " von dem Lieferanten " & _
strLieferant & " existiert " & IIf(WorkSheetExists(strSachnummer), "", "nicht ") _
& " als Tabellenblatt."
ActiveWorkbook.Close False
strDatei = Dir()
Loop
End Sub
Public Function WorkSheetExists(ByVal strName As String) As Boolean
'On Error Resume Next
WorkSheetExists = Not ThisWorkbook.Worksheets(strName) Is Nothing
End Function
Hallo Philipp,
(23.10.2018, 11:36)Philipp1344 schrieb: [ -> ]Nach Öffnen der Angebotsdatei erscheint zudem das Info-Fenster "Index außerhalb des gültigen Bereichs". (?????)
wenn ich mal aus deinen ersten Beitrag zitieren darf
(18.10.2018, 10:07)Philipp1344 schrieb: [ -> ]Datei: Angebot_Lieferant1_Sachnummer1
Werte die verglichen, bzw in Vergleichsdatei kopiert werden sollen:E24, E29, E31, E38, E44, ...
in Vergleichsdatei (Tabellenblattname = Sachnummer): D10, D15, D17, D24, D30, ... (Beginnt in anderer Zelle, dann aber in gleicher Zählweise, bzw. Sprüngen "nach unten" wie in Quelldatei)
Datei: Angebot_Lieferant2:Sachnummer1
soll dann exakt gleich in Vergleichsdatei eingefügt werden, jedoch in Spalte H (immer 4 Spalten weiter rechts)
mein Code bezieht sich darauf, dass sich die Sachnummer als Tabellenblattname in deiner Vergleichsdatei befindet. Dem scheint jetzt wohl nicht so zu sein.