FileSearch
29.07.2020 09:45:08
Charles
Ich habe eine große Bitte! Ein Freund hat mir diesen Code vor einiger Zeit geschrieben und jetzt funktioniert er nicht mehr. Nach einigen Recherchen hab ich herausgefunden, dass das FileSearch nicht mehr unterstützt wird. Könntet ihr mir bitte den Code so abändern, dass er wieder funzt?
Danke Vielmals
Charles
Public Sub Blatt_kopieren()
Dim WS_kopie As Worksheet
Dim i As Integer
Dim WB As Workbook
Set WS_kopie = ThisWorkbook.Sheets("Übersicht")
With Application.FileSearch
.NewSearch
.LookIn = "U:\Karl Heinz/Test Aufträge" ' 0 Then
For i = 1 To .FoundFiles.Count
If .FoundFiles(i) ThisWorkbook.FullName Then
Set WB = Workbooks.Open(Filename:=.FoundFiles(i))
WS_kopie.Copy after:=WB.Sheets(WB.Sheets.Count)
WB.ChangeLink Name:=ThisWorkbook.Name, NewName:=WB.Name, Type:=xlExcelLinks
WB.Close savechanges:=True
End If
Next i
Else
MsgBox "Es wurden keine Exceldateien gefunden.", vbCritical, "Achtung"
End If
End With
End Sub
