Offene Datei aus Abfrage ausschließen

If strFile ActiveWorkbook.Name Then 'Mit If wollte ich die Datei ausschließen Set oWkb1 = Workbooks.Open(avntFolders(ialngFolders) & strFile) Set oWks1 = oWkb1.Sheets(1) For i = 0 To UBound(aCells) oWks0.Cells(iNextLine, iStartSpalte).Offset(0, i).Value = _ oWks1.Range(aCells(i)).Value End If

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Set oWks0 = ActiveSheet aCells = Split(Zellen, ",") iNextLine = iStartZeile For ialngFolders = LBound(avntFolders) To UBound(avntFolders) strFile = Dir$(avntFolders(ialngFolders) & "*nk*" & "*.xlsm") Do Until strFile = vbNullString Set oWkb1 = Workbooks.Open(avntFolders(ialngFolders) & strFile) Set oWks1 = oWkb1.Sheets(1) For i = 0 To UBound(aCells) oWks0.Cells(iNextLine, iStartSpalte).Offset(0, i).Value = _ oWks1.Range(aCells(i)).Value Next Call oWkb1.Close(SaveChanges:=False) iNextLine = iNextLine + 1 strFile = Dir$ Loop Next

Do Until strFile = vbNullString If Workbooks(strFile) is nothing Then Set oWkb1 = Workbooks.Open(avntFolders(ialngFolders) & strFile) Set oWks1 = oWkb1.Sheets(1) For i = 0 To UBound(aCells) oWks0.Cells(iNextLine, iStartSpalte).Offset(0, i).Value = _ oWks1.Range(aCells(i)).Value Next Call oWkb1.Close(SaveChanges:=False) iNextLine = iNextLine + 1 strFile = Dir$ End If Loop

Do Until strFile = vbNullString If Workbooks(strFile) ActiveWorkbook.Name Then Set oWkb1 = Workbooks.Open(avntFolders(ialngFolders) & strFile) Set oWks1 = oWkb1.Sheets(1) For i = 0 To UBound(aCells) oWks0.Cells(iNextLine, iStartSpalte).Offset(0, i).Value = _ oWks1.Range(aCells(i)).Value Next Call oWkb1.Close(SaveChanges:=False) iNextLine = iNextLine + 1 strFile = Dir$ End If Loop

If strFile ActiveWorkbook.Name Then GoTo Continue For ialngFolders = LBound(avntFolders) To UBound(avntFolders) strFile = Dir$(avntFolders(ialngFolders) & "*.xls") '& "*nk*" Do Until strFile = vbNullString 'If strFile ActiveWorkbook.Name Then Set oWkb1 = Workbooks.Open(avntFolders(ialngFolders) & strFile) Set oWks1 = oWkb1.Sheets(1) For i = 0 To UBound(aCells) oWks0.Cells(iNextLine, iStartSpalte).Offset(0, i).Value = _ oWks1.Range(aCells(i)).Value Next Call oWkb1.Close(SaveChanges:=False) iNextLine = iNextLine + 1 strFile = Dir$ 'End If Loop Continue: Next ialngFolders

Set oWks0 = ActiveSheet aCells = Split(Zellen, ",") iNextLine = iStartZeile For ialngFolders = LBound(avntFolders) To UBound(avntFolders) strFile = Dir$(avntFolders(ialngFolders) & "*test*.xls*") Do Until strFile = vbNullString Set oWkb1 = Workbooks.Open(avntFolders(ialngFolders) & strFile) Set oWks1 = oWkb1.Sheets(1) For i = 0 To UBound(aCells) oWks0.Cells(iNextLine, iStartSpalte).Offset(0, i).Value = _ oWks1.Range(aCells(i)).Value Next Call oWkb1.Close(SaveChanges:=False) iNextLine = iNextLine + 1 strFile = Dir$ Loop Next Set oWks0 = Nothing Set oWks1 = Nothing Set oWkb1 = Nothing

Habe in einem anderen Forum etwas gefunden, aber die Abfrage bleibt in der Schleife hängen und Excel hängt sich auf.

    Dim wbDst As Workbook
Set wbDst = ThisWorkbook
Set oWks0 = ActiveSheet
aCells = Split(Zellen, ",")
iNextLine = iStartZeile
For ialngFolders = LBound(avntFolders) To UBound(avntFolders)
'"*.xls*" verwenden, wenn alle Dateiendungen abgefragt werden sollen
strFile = Dir$(avntFolders(ialngFolders) & "*.xls")
Do Until strFile = ""
If strFile  wbDst.Name Then
Set oWkb1 = Workbooks.Open(avntFolders(ialngFolders) & strFile)
Set oWks1 = oWkb1.Sheets(1)
For i = 0 To UBound(aCells)
oWks0.Cells(iNextLine, iStartSpalte).Offset(0, i).Value = _
oWks1.Range(aCells(i)).Value
Next
Call oWkb1.Close(SaveChanges:=False)
iNextLine = iNextLine + 1
strFile = Dir$
End If
Loop
Next
Set oWks0 = Nothing
Set oWks1 = Nothing
Set oWkb1 = Nothing

Hoffe jemand kann mir helfen.
Gruß
Roman

Do Until strFile = vbNullString On Error Resume Next Set oWkb1 = Workbooks(strFile) On Error GoTo 0 If oWkb1 Is Nothing Then Set oWkb1 = Workbooks.Open(avntFolders(ialngFolders) & strFile) Set oWks1 = oWkb1.Sheets(1) For i = 0 To UBound(aCells) oWks0.Cells(iNextLine, iStartSpalte).Offset(0, i).Value = _ oWks1.Range(aCells(i)).Value Next Call oWkb1.Close(SaveChanges:=False) iNextLine = iNextLine + 1 strFile = Dir$ End If Loop

Beliebteste Forumthreads (12 Monate)

Offene Datei aus Abfrage ausschließen

8 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

8
Beiträge zum Forumthread

Beiträge zu diesem Forumthread