Hilfe: Application.Filesearch umschreiben
Pierre
Hatte eben schon mal einen Beitrag geschrieben, aber ich komme einfach nicht weiter. Das Makro aus 2003 funktioniert nicht im 2007, weil 2007 die "Application.FileSearch" nicht unterstützt.
Ich habe mir das angeschaut und schaffe es ehrlich gesagt nicht das Makro umzuschreiben. Ist schon etwas her, dass ich das mal erstellt habe. Wäre vielleicht jemand so lieb mir das eben umzuschreiben? Brauche es nämlich dringend! Danke und Grüße!
Sub Einfügen()
Dim objWb As Workbook
Dim intCount As Integer, lngRow As Long
Dim vntC As Variant, lngCol As Long
Const strCells As String = _
"E1,E2,E3,B6,B18,B20,B23,B37,B39,E5,E9,E10,E23,E24,B34,F28,I28,I9,I10,I11,I12,I14,I22,I25,I16,I17,I18,I19,I20,I34,I37,J9,J10,J11,J12,J14,J22,J25,J16,J17,J18,J19,J20,J34,J37,K9,K10,K11,K12,K14,K22,K25,K16,K17,K18,K19,K20,K34,K37"
On Error GoTo ErrExit
Call EventsOff
lngRow = Application.Max(4, ThisWorkbook.Sheets("Tabelle1").Cells(Rows.Count, 1).End(xlUp).Row + 1)
vntC = Split(strCells, ",")
With Application.FileSearch
.NewSearch
.LookIn = "C:\Praktikum"
.SearchSubFolders = True
.Filename = "*.xls" 'es werden nur xls-intCount aus dem ordner verwendet
If .Execute() > 0 Then
For intCount = 1 To .FoundFiles.Count
If .FoundFiles(intCount) ThisWorkbook.FullName Then
Set objWb = Workbooks.Open(.FoundFiles(intCount)) 'öffnet die Datei
For lngCol = 1 To UBound(vntC) + 1
ThisWorkbook.Sheets("Tabelle1").Cells(lngRow, lngCol) = objWb.Sheets("Tabelle1").Range(vntC(lngCol - 1)).Value
Next
objWb.Close False 'schließt die Datei
lngRow = lngRow + 1
End If
Next
End If
End With
ErrExit:
If Err.Number 0 Then
MsgBox "Fehler:" & vbTab & Err.Number & vbLf & vbLf & Err.Description, vbExclamation, "Fehler"
End If
Call EventsOn
Set objWb = Nothing
End Sub
Public Sub EventsOff()
With Application
.ScreenUpdating = False
.EnableEvents = False
.Calculation = xlCalculationManual
End With
End Sub
Public Sub EventsOn()
With Application
.ScreenUpdating = True
.EnableEvents = True
.Calculation = xlCalculationAutomatic
End With
End Sub
Anzeige