AW: Tabellenblatt ersetzen
01.06.2006 09:29:21
Matthias G
Hallo Robert,
ich hoffe, das klappt so:
Option Explicit
Const PfadLokal = "C:\Dokumente und Einstellungen\Matthias\Desktop\Jo\Robert\lokal"
Const PfadNetz = "C:\Dokumente und Einstellungen\Matthias\Desktop\Jo\Robert\netz"
Const Tauschname = "Tabelle1" 'Name der zu tauschenden Blattes
Sub ErstelleDateilisten()
Dim fn As String, z As Integer, i As Integer, found As Integer
Cells.ClearContents
z = 0
'lokale Liste
fn = Dir(PfadLokal & "\*.xls")
Do While fn <> ""
z = z + 1
Cells(z, 1) = fn
fn = Dir()
Loop
Columns(1).AutoFit
'Liste im Netzverzeichnis
z = 0
For z = 1 To Cells(Rows.Count, 1).End(xlUp).Row
With Application.FileSearch
.NewSearch
.LookIn = PfadNetz
.SearchSubFolders = True
.Filename = "*_" & Cells(z, 1)
found = .Execute()
Select Case found
Case 0
Cells(z, 2) = "\NICHT GEFUNDEN!"
Case 1
Cells(z, 2) = .FoundFiles.Item(1)
Case Else
Cells(z, 2) = "\" & " UNEINDEUTIG! " & found & " mal gefunden"
End Select
End With
Next z
Columns(2).AutoFit
End Sub
Sub TauscheBlätter()
Dim fileNEU As String, fileALT As String
Dim z As Long
Dim wbALT As Workbook, wbNEU As Workbook, sh As Worksheet
Set sh = ActiveSheet
For z = 1 To sh.Cells(Rows.Count, 1).End(xlUp).Row
fileNEU = PfadLokal & "\" & sh.Cells(z, 1)
fileALT = sh.Cells(z, 2)
If Left(fileALT, 1) = "\" Then
sh.Cells(z, 3) = "--ausgelassen--"
Else
sh.Cells(z, 3) = "Öffne Datei in Netz..."
Set wbALT = Workbooks.Open(Filename:=fileALT)
sh.Cells(z, 3) = "lösche Blatt..."
Application.DisplayAlerts = False
wbALT.Sheets(Tauschname).Delete
Application.DisplayAlerts = True
sh.Cells(z, 3) = "Öffne neue Datei..."
Set wbNEU = Workbooks.Open(Filename:=fileNEU)
sh.Cells(z, 3) = "Kopiere Blatt..."
wbNEU.Sheets(Tauschname).Copy Before:=wbALT.Sheets(1)
wbNEU.Close Savechanges:=False
sh.Cells(z, 3) = "Mappe im Netz speichern..."
wbALT.Close Savechanges:=True
sh.Cells(z, 3) = "OK"
End If
Next z
End Sub
Alles in ein Modul in neue Mappe, die Konstanten (PfadLokal, PfadNetz, Tauschname) anpassen und viel Erfolg!
Matthias