Guten Abend
Nachfolgender Code öffnet in definierten Pfaden bestimmte Dateien (sofern nicht bereits offen), übernimmt den Inhalt des ersten Workheets in die Datei, aus welcher der Code aufgeruft wird und schliesst die Dateien wieder (sofern diese nicht bereits vor Ausführung des Codes offen waren.
Das klappt soweit gut.
Nun versuchte ich das Oeffnen Übernehmen der Daten einzuschränken. So sollen Dateien, die den String "_XXX_" im Dateinamen haben, übersprungen werden.
Das woltle ich mit folgender Codezeile erledigen:
If InStr(strFile, "_XXX_") = 0 Then
End If
Ich bin daran gescheitert, da ich nicht herausgefunden habe, wo ich das End If einsetzen muss - dort wo ich es erwartet habe klappt es nicht.
Kann mir jemand helfen?
Danke und Gruss, Peter
Option Explicit
<pre>Sub OUT_put_to_XXX()
Dim objWB As Workbook, WB_THIS As Workbook, objWBOpen As Workbook, Rng1 As Range, Rng2 As Range, vntOpen() As Variant, lngIndex As Long
Dim strPath_fwpFiles As String, bolOpen As Boolean, strFile As String, rngFound As Range, strMandant As String, strSpaZelleLinks As String
Dim WS_IN_ As Worksheet, WS_COCKPIT As Worksheet, WS_DATA_IN_ As Worksheet, WB_TEMP As Workbook, WS_TEMP As Worksheet
Dim intHeader As Integer, intSpalten As Integer, intZeilen As Integer, rngQuelle As Range, rngZiel As Range, rngFileErstellt As Range, rngTemp As Range
Dim rngFilePfad As Range, rngFileName As Range
Dim intZeiA As Integer, intZeiE As Integer
Set WB_THIS = ThisWorkbook
Set WS_COCKPIT = WB_THIS.Sheets("Cockpit")
Set WS_IN_ = WB_THIS.Sheets("Files_IN_")
Set WS_DATA_IN_ = WB_THIS.Sheets("Data_IN_")
ThisWorkbook.Activate
WS_COCKPIT.Activate
WS_IN_.UsedRange.ClearContents
WS_DATA_IN_.UsedRange.ClearContents
intHeader = 1
strSpaZelleLinks = "E"
Debug.Print Now
'Es wird abgefragt, ob die betroffenen Files bereits offen sind - Files die nicht offen sind, werden nach den vorgenommenen
'Abfragen wieder geschlossen - ohne Speichern
'"Betroffene" INPUT-Files öffnen, sofern nicht bereits offen
ReDim vntOpen(0)
For Each Rng1 In WS_COCKPIT.Range("_Path_IN_") '''''''''''''''AAA
For Each Rng2 In WS_COCKPIT.Range("_File_IN_String") '''''''''''''''BBB
If Rng2 <> "" Then '''''''''''''''''''CCC
strFile = Dir(Rng1.Text & Rng2.Text & "*.csv", vbNormal)
'''' If InStr(strFile, "_XXX_") = 0 Then
WS_IN_.Cells(WS_IN_.Cells(WS_IN_.Rows.Count, "A").End(xlUp).Row + 1, "A").Value = strFile
Do While Len(strFile) > 0
bolOpen = False
For Each objWB In Application.Workbooks
If objWB.Name = strFile Then
bolOpen = True
Exit For
End If
Next
If Not bolOpen Then
If IsError(Application.Match(Rng1.Text & strFile, vntOpen, 0)) Then
ReDim Preserve vntOpen(lngIndex)
vntOpen(lngIndex) = Rng1.Text & strFile
lngIndex = lngIndex + 1
Workbooks.Open Filename:=Rng1.Text & strFile, local:=True
End If
End If
Set WB_TEMP = Workbooks(strFile)
Set WS_TEMP = WB_TEMP.Sheets(1)
intZeilen = WS_TEMP.Cells(WS_TEMP.Rows.Count, 1).End(xlUp).Row
intSpalten = WS_TEMP.Cells(1, WS_TEMP.Columns.Count).End(xlToLeft).Column
If intHeader = 1 Then
Set rngQuelle = WS_TEMP.Range(WS_TEMP.Cells(1, 1), WS_TEMP.Cells(intZeilen, intSpalten))
Else
Set rngQuelle = WS_TEMP.Range(WS_TEMP.Cells(2, 1), WS_TEMP.Cells(intZeilen, intSpalten))
End If
If intHeader = 1 Then
Set rngZiel = WS_DATA_IN_.Cells(WS_DATA_IN_.Cells(WS_DATA_IN_.Rows.Count, strSpaZelleLinks).End(xlUp).Row, strSpaZelleLinks)
intHeader = 0
WS_DATA_IN_.Cells(1, 1).Value = "File erstellt"
WS_DATA_IN_.Cells(1, 2).Value = "Aktuell"
WS_DATA_IN_.Cells(1, 3).Value = "Pfad"
WS_DATA_IN_.Cells(1, 4).Value = "Filename"
Else
Set rngZiel = WS_DATA_IN_.Cells(WS_DATA_IN_.Cells(WS_DATA_IN_.Rows.Count, strSpaZelleLinks).End(xlUp).Row + 1, strSpaZelleLinks)
End If
'Quellbereich kopieren
rngQuelle.Copy
'Quellbereich einfügen (zuerst alles, dann Werte - womit Formate bleiben)
With rngZiel
.PasteSpecial Paste:=xlPasteAll
.PasteSpecial Paste:=xlPasteValues
.Interior.ColorIndex = xlNone
Application.CutCopyMode = False
End With
WB_THIS.Activate
With WS_DATA_IN_
intZeiA = .Cells(WS_DATA_IN_.Rows.Count, "A").End(xlUp).Row + 1
intZeiE = .Cells(WS_DATA_IN_.Rows.Count, strSpaZelleLinks).End(xlUp).Row
''Debug.Print intZeiA & " Start " & intZeiE & " Ende"
End With
Set rngFileErstellt = WS_DATA_IN_.Range(WS_DATA_IN_.Cells(intZeiA, 1), WS_DATA_IN_.Cells(intZeiE, 1))
Set rngFilePfad = WS_DATA_IN_.Range(WS_DATA_IN_.Cells(intZeiA, 3), WS_DATA_IN_.Cells(intZeiE, 3))
Set rngFileName = WS_DATA_IN_.Range(WS_DATA_IN_.Cells(intZeiA, 4), WS_DATA_IN_.Cells(intZeiE, 4))
' WB_TEMP.Activate
With rngFileErstellt
.Value = FileChangeDat(WB_TEMP.FullName)
.NumberFormat = "DD.MM.YYYYY HH:MM:SS"
End With
With rngFilePfad
.Value = WB_TEMP.Path
.NumberFormat = "General"
End With
With rngFileName
.Value = WB_TEMP.Name
.NumberFormat = "General"
End With
' ThisWorkbook.Activate
If lngIndex > 0 Then
If Not IsError(Application.Match(Rng1.Text & strFile, vntOpen, 0)) Then
Workbooks(strFile).Close , False
End If
End If
'''' End If
strFile = Dir
Loop
End If ''''''CCC
Next ''''''''BBB
Next '''''''''AAA
End Sub</pre>