filesearch und copy in 2010
17.05.2013 12:30:31
Oli
bis jetzt haben mir die beiträge hier sehr geholfen, aber aktuell hänge ich fest und komme auch mit den bisherigen beiträgen zum thema filesearch nicht weiter.
das die funktion in excel2010 ja nichtmehr funktioniert gibt es ja diverse umwege um die alte (schön einfache) funktion über jede menge code zum laufen zu bringen.
ich arbeite selbst mit excel2003 aber muss es fürs 2010er zum laufen kriegen. daher kann ich leider nur sehr begrenzt auf dem 2010er testen!
so siehts aktuell aus:
Const SuchPfad = "C:\Users\PFAD" 'Pfad in dem die Exceldateien liegen
Sub Dateien_Zusammensetzen()
With Application.FileSearch
.NewSearch
.LookIn = SuchPfad
.SearchSubFolders = True
.Filename = "*.xls"
.FileType = msoFileTypeAllFiles
If .Execute() > 0 Then
For i = 1 To .FoundFiles.Count
KopiereTabellen .FoundFiles(i)
Next i
Else
MsgBox "There were no files found."
End If
End With
End Sub
Sub KopiereTabellen(Dateiname As String)
Dim OurBook As Workbook, CopyBook As Workbook
Dim S As Worksheet
Dim SName As String
Set OurBook = ActiveWorkbook
Set fs = CreateObject("Scripting.FileSystemObject")
Workbooks.Open Filename:=Dateiname
Set CopyBook = ActiveWorkbook
For Each S In Sheets
SName = S.Name
S.Copy After:=OurBook.Sheets(OurBook.Sheets.Count)
OurBook.Sheets(OurBook.Sheets.Count).Name = _
fs.GetBaseName(CopyBook.Name) & "-" & SName
Next
CopyBook.Close SaveChanges:=False
Sheets("Start").Select
End Sub
- durch neuen code?
- ODER: durch eine eigene application die mit filesearch angesprochen wird und nur im hintergrund eingebaut wird? damit ich den bestehen code kaum ändern muss.
mir sind beide wege recht. wäre natürlich auch sehr gut, wenn die version dann auf excel2010 und excel2003 läuft und ich keine 2 versionen verwenden muss!
danke schonmal für jede hilfe!
Anzeige