Office: Daten verschoben- Links in Exceldateien automatisch anpassen

Ich habe mit der Suchfunktion leider nichts gefunden, hier mein Problem:

Wir haben technisch bedingt Daten verschieben müssen. Jetzt sind natürlich in sämtlichen Exceldateien die verknüpfungen zu fremden Blättern falsch. und es sind sehr viele Dateien. Gibt es ein Programm/Makro/sonst etwas was es ermöglicht, in ALLEN dateien nach der alten Adresse sucht und diese durch die neue ersetzt.
Also wenn es vorher auf U:\TeamOrdner\ , dass er das sucht und durch den neuen Server Z:\TeamOrdner\ ersetzt.

Herzlichen Dank im voraus!

 

Hallo!

Menü Bearbeiten > Ersetzen (Strg+h):
Suchen nach: U:\TeamOrdner
Ersetzen durch: Z:\TeamOrdner

Das sollte es schon gewesen sein, oder?

 

Für eine Datei. Aber das für Alle zu machen ist doch sehr mühsam. hatte gehofft, dass es einfacher möglich ist.

Edit: nochmal zur verdeutlichung:
Es gibt sehr viele dateien, in denen eine solche Verlinkung enthalten ist. und die möchte ich nicht einzeln aufrufen um es dann wie beschrieben zu ersetzen, sondern am liebsten alle auf einmal bearbeiten.

 

Uups...
Wer lesen kann, ist klar im Vorteil...
Ich hoffe, dass wenigstens alle Dateien im gleichen Ordner liegen.
Dann kopiere diesen Code in ein Modul irgendeiner Mappe, die NICHT in diesem Ordner liegt und lass ihn laufen.

Code:

Sub Ersetzen()
Dim Mappe As String
Dim Blatt As Integer
'HIER DAS VERZEICHNIS ANGEBEN!!!!
Const Pfad = "D:\Temp\"
Mappe = Dir(Pfad & "*.xl*")
Do While Mappe <> ""
On Error Resume Next
Workbooks.Open Pfad & Mappe, UpdateLinks:=0
For Blatt = 1 To Workbooks(Mappe).Sheets.Count
    Cells.Replace What:="U:\TeamOrdner\", Replacement:="Z:\TeamOrdner\", _
    LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False, _
    SearchFormat:=False, ReplaceFormat:=False
Next Blatt
Workbooks(Mappe).Close SaveChanges:=True
Mappe = Dir
Loop
End Sub

 

Es ergibt einen fehler:

 

Sorry, du musst das "D:\Temp\" durch deinen Pfad ersetzen!

 

Habe es durch C:\Temp ersetzt (den gibt es). Fehler besteht weiterhin

 

Nein,
ersetze es durch den Pfad, in dem sich deine Dateien befinden, also offensichtlich wohl durch "J:\Lars\InvestNet\"
Achte auch auf den letzten Backslash!

 

Code:

Sub Ersetzen() 
Dim Mappe As String 
Dim Blatt As Integer 
'X:\XBFC\XBFC 4\InvestNet\' <- Hier das Verzeichnis in dem Dateien lagern?
Const Pfad = "X:\XBFC\XBFC 4\InvestNet\" < Hier auch ? (es kommt mir komisch vor :) )
Mappe = Dir(Pfad & "*.xl*") 
Do While Mappe <> "" 
On Error Resume Next 
Workbooks.Open Pfad & Mappe, UpdateLinks:=0 
For Blatt = 1 To Workbooks(Mappe).Sheets.Count 
    Cells.Replace What:="X:\LARS\", Replacement:="X:\XBFC\XBFC 4\", _
    LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False, _ 
    SearchFormat:=False, ReplaceFormat:=False 
Next Blatt 
Workbooks(Mappe).Close SaveChanges:=True 
Mappe = Dir 
Loop 
End Sub

Wäre das dann so richtig? Die Exceldateien sind aus dem ordner LARS in den Ordner XBFC\XBFC 4\ kopiert worden. In dem Ordner X:\XBFC\XBFC 4\InvestNet\ sind Exceldateien die angeglichen werden müssen.

 

Die Zeile mit dem Hochkomma am Anfang ist nur ein Kommentar, der nicht ausgeführt wird. Wenn deine Dateien im Ordner "X:\XBFC\XBFC 4\InvestNet\" liegen und wenn "X:\LARS\" durch "X:\XBFC\XBFC 4\" ersetzt werden soll, dann ist dein Code jetzt korrekt.

 

Okey, das ist soweit sehr gut. Danke schonmal!
Gibt es eine Möglichkeit Unterordner in diese Formel einzuschließen?

Ich weiß du hattest am anfang gefragt, aber wollte es erst einmal einfach halten :)

Code:

Const Pfad = "X:\XBFC\XBFC 4\"

Es dürfte ja in dieser Zeile sein. (in diesem Ordner sind diverse Unterordner die wieder unterordner haben).
Gibt es einen anderen befehl um die konstanz aufzuheben?

 

Hallo!

Dafür reichen meine VBA-Kenntnisse leider nicht aus.
Vielleicht hilft dir dieser Link weiter zum basteln:
http://www.office-loesung.de/ftopic141069_0_0_asc.php

 

Aus gegebenem Anlass habe ich nocheinmal danach geguckt und folgendes zusammengeschmolzen. Mein (glaube ich ;-) ) letztes Problem ist die Benennung von Pfad3 , der nur den Dateinamen enthalten soll. Setze ich Pfad2 ein gibt er natürlich den gesamten Pfad ein, was einen Indexerror erzeugt.
Hast du dafür vielleicht eine Lösung?

Code:

Sub einlesen()
  Pfad = "C:\DATA\Profiles\A352265\Desktop\Test\"
  With Application.FileSearch
    .NewSearch
    .LookIn = Pfad
    .SearchSubFolders = True
    .Filename = "*.xl*"
    .Execute
    If .Execute() > 0 Then
      For i = 1 To .FoundFiles.Count
        pfad2 = .FoundFiles(i)
        pfad3 =
        Workbooks.Open pfad2, UpdateLinks:=0
            For Blatt = 1 To Workbooks(pfad3).Sheets.Count
                Cells.Replace What:="C:\DATA\Profiles\A352265\Desktop\Hilf\", Replacement:="C:\DATA\Profiles\A352265\Desktop\wasserhahn\", _
                LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False, _
                SearchFormat:=False, ReplaceFormat:=False
            Next Blatt
      Next i
      Workbooks(pfad2).Close savechanges:=True
    End If
  End With
End Sub

 

Hallo!

Vielleicht hilft dir dies:

Code:

DName = Right(DName, Len(DName) - InStrRev(DName, "\"))

Diese Zeile kürzt z.B. hieraus

Code:

C:\Oberpfad\Unterpfad\Dateiname.xls

alle Pfade, so dass

Code:

Dateiname.xls

übrig bleibt.

 

Hi, Ich bins nochmal! Deine Formel hat geholfen, das Problem ist behoben , das Makro funktioniert.

Allerdings gibt es noch 2 Probleme:
1. Die Arbeitsmappen werden nicht geschlossen nach dem ändern. // Problem selbst gelöst. lag an der reihenfolge -.-
2. Das Makro geht nur in die jeweils aktive Seite (worksheet) und nicht durch alle blätter innerhalb einer exceldatei.

Wenn die 2 Probleme gelöst werden könnten, wäre ich sehr sehr happy!

Code:

Sub einlesen()
  Pfad = "C:\DATA\Profiles\A352265\Desktop\Test\"
  With Application.FileSearch
    .NewSearch
    .LookIn = Pfad
    .SearchSubFolders = True
    .Filename = "*.xl*"
    .Execute
    If .Execute() > 0 Then
      For i = 1 To .FoundFiles.Count
        pfad2 = .FoundFiles(i)
        DName = pfad2
        DName = Right(DName, Len(DName) - InStrRev(DName, "\"))
        Workbooks.Open pfad2, UpdateLinks:=0
            For Blatt = 1 To Workbooks(DName).Sheets.Count
                Cells.Replace What:="C:\DATA\Profiles\A352265\Desktop\Hilf\", Replacement:="C:\DATA\Profiles\A352265\Desktop\wasserhahn\", _
                LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False, _
                SearchFormat:=False, ReplaceFormat:=False
            Next Blatt
      Workbooks(DName).Close savechanges:=True
      Next i
    End If
  End With
End Sub

Gruss