Top-Themen

AppleEntwicklungHardwareInternetLinuxMicrosoftMultimediaNetzwerkeOff TopicSicherheitSonstige SystemeVirtualisierungWeiterbildungZusammenarbeit

Aktuelle Themen

Administrator.de FeedbackApache ServerAppleAssemblerAudioAusbildungAuslandBackupBasicBatch & ShellBenchmarksBibliotheken & ToolkitsBlogsCloud-DiensteClusterCMSCPU, RAM, MainboardsCSSC und C++DatenbankenDatenschutzDebianDigitiales FernsehenDNSDrucker und ScannerDSL, VDSLE-BooksE-BusinessE-MailEntwicklungErkennung und -AbwehrExchange ServerFestplatten, SSD, RaidFirewallFlatratesGoogle AndroidGrafikGrafikkarten & MonitoreGroupwareHardwareHosting & HousingHTMLHumor (lol)Hyper-VIconsIDE & EditorenInformationsdiensteInstallationInstant MessagingInternetInternet DomäneniOSISDN & AnaloganschlüsseiTunesJavaJavaScriptKiXtartKVMLAN, WAN, WirelessLinuxLinux DesktopLinux NetzwerkLinux ToolsLinux UserverwaltungLizenzierungMac OS XMicrosoftMicrosoft OfficeMikroTik RouterOSMonitoringMultimediaMultimedia & ZubehörNetzwerkeNetzwerkgrundlagenNetzwerkmanagementNetzwerkprotokolleNotebook & ZubehörNovell NetwareOff TopicOpenOffice, LibreOfficeOutlook & MailPapierkorbPascal und DelphiPeripheriegerätePerlPHPPythonRechtliche FragenRedHat, CentOS, FedoraRouter & RoutingSambaSAN, NAS, DASSchriftartenSchulung & TrainingSEOServerServer-HardwareSicherheitSicherheits-ToolsSicherheitsgrundlagenSolarisSonstige SystemeSoziale NetzwerkeSpeicherkartenStudentenjobs & PraktikumSuche ProjektpartnerSuseSwitche und HubsTipps & TricksTK-Netze & GeräteUbuntuUMTS, EDGE & GPRSUtilitiesVB for ApplicationsVerschlüsselung & ZertifikateVideo & StreamingViren und TrojanerVirtualisierungVisual StudioVmwareVoice over IPWebbrowserWebentwicklungWeiterbildungWindows 7Windows 8Windows 10Windows InstallationWindows MobileWindows NetzwerkWindows ServerWindows SystemdateienWindows ToolsWindows UpdateWindows UserverwaltungWindows VistaWindows XPXenserverXMLZusammenarbeit
GELÖST

Excel-Verknüpfung in vielen Dateien ersetzen?

Frage Entwicklung VB for Applications

Mitglied: goodbytes

goodbytes (Level 2) - Jetzt verbinden

15.10.2012, aktualisiert 10:18 Uhr, 7695 Aufrufe, 7 Kommentare

Hallo,
ich habe einen Ordner mit sehr vielen Excel-Dateien, in welchen sich Verknüpfungen zu einer anderen Datei befinden. Es werden bei diesen Dateien Adressdaten aus einer Datei gezogen.

Leider hatte vor langer Zeit mal Jemand die glorreiche Idee sich diese Adressdatei auf den loaklen Rechner zu kopieren und beim Vorbereiten der neuen Dateien mit der Verknüpfung auf die Adressdatei des lokalen Rechners zu verwenden.

Dadurch enthalten hunderte Excel-Dateien eine falsche Verknüpfung und das Öffnen dauert ewig, weil der Pfad nicht mehr gefunden wird. Der alte Rechner existiert nicht mehr.

Nun würde ich gerne per Makro alle Dateien durchlaufen lassen und den Link \\AlterRechner\Eigene Dateien... durch \\IPdesServers\Pfad ersetzen.

Wie könnte ich da per Makro oder VBS realisieren?

Danke schon mal im Voraus!

Gruß
Torsten
Mitglied: colinardo
15.10.2012, aktualisiert um 12:08 Uhr
Wie sind die Dateien in Excel eingebunden ? Als Datenquelle oder als Hyperlink ?
Bitte warten ..
Mitglied: goodbytes
15.10.2012 um 12:57 Uhr
Hallo Softmeister,
die Verknüpfung ist mittels SVERWEIS eingebunden:

01.
=SVERWEIS(WERT(M1);'D:\Pfad\[Datei.xls]Sheet'!$B$1:$F$65536;5;0)
Im Prinzip würde es mir künftig reichen, wenn die Verknüpfung beim ersten Speichern automatisch entfernt wird und nur der Wert drin bleibt. Die Verknüpfung ist dann ja nicht mehr notwendig.

Das kann ich so lösen:

01.
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean) 
02.
   ActiveWorkbook.BreakLink Name:="D:\Pfad\Datei.xls", Type:=xlExcelLinks 
03.
   ThisWorkbook.Saved = True 
04.
End Sub
Allerdings müsste der Verweis bei den vielen bereits erstellten Vorlagen erst einmal Datei für Datei entfernt werden.
Das wollte ich gerne pro Ordner automatisiert ausführen lassen.

Gruß
Torsten
Bitte warten ..
Mitglied: colinardo
15.10.2012, aktualisiert um 14:16 Uhr
Hier ein Ansatz für ein Makro:
Die Sub ChangeMultipleFiles sucht sich erst mal alle Excel-Dateien in dem angegebenen Ordner raus um dann die Datei zu öffnen und die entsprechenden Stellen im Dokument zu ersetzen.
Die Funktion ReplacePath sucht in der Arbeitsmappe entsprechende Textstellen und ersetzt sie durch deine Angaben mit dem Aufruf: ReplacePath "D:\Pfad\", "\\Server\".
Zum Schluss speichert das Makro die Datei und schließt sie wieder, dann gehts auf zum nächsten Excel-File.
Du kannst dann noch das ActiveWorkbook.BreakLink mit einbauen.

01.
Function ReplacePath (oldpath As String, newpath As String) 
02.
     
03.
   cells.Replace What:=oldpath, Replacement:=newpath, LookAt:=xlPart, _ 
04.
            SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _ 
05.
            ReplaceFormat:=False 
06.
         
07.
End Function 
08.
 
09.
Sub ChangeMultipleFiles() 
10.
    FOLDER_EXCELFILES = "C:\excelfiles\" 
11.
    Set fso = CreateObject("Scripting.Filesystemobject") 
12.
    Set folderExcelFiles = fso.GetFolder(FOLDER_EXCELFILES) 
13.
     
14.
    For Each file In folderExcelFiles.Files 
15.
        ext = Right(file.Name, Len(file.Name) - InStrRev(file.Name, ".")) 
16.
        If LCase(ext) = "xls" Or LCase(ext) = "xlsx" Then 
17.
            Dim doc As Workbook 
18.
            Debug.Print file.Path 
19.
            Set doc = Application.Workbooks.Open(file.Path, 0) 
20.
            ReplacePath "D:\Pfad\", "\\Server\" 
21.
            doc.Save 
22.
            doc.Close 
23.
        End If 
24.
         
25.
    Next 
26.
End Sub
Grüße Uwe
Bitte warten ..
Mitglied: goodbytes
16.10.2012 um 14:24 Uhr
Hallo Uwe,
vielen Dank erst einmal für diese Superlösung.

Ich habe jetzt die Links entfernt. Dazu habe ich noch eine Schleife eingebaut, damit auch alle Sheets durchgegangen werden.

So sieht es jetzt aus:

01.
Function DeleteLink(Anzahl As Integer, Link_1 As String, Link_2 As String, Link_3 As String, Link_4 As String, Link_5 As String, Link_6 As String) 
02.
 
03.
On Error Resume Next 
04.
 
05.
For i = 1 To Anzahl 
06.
    ActiveWorkbook.Sheets(i).Activate 
07.
    ActiveWorkbook.BreakLink Name:=Link_1, Type:=xlExcelLinks 
08.
    ActiveWorkbook.BreakLink Name:=Link_2, Type:=xlExcelLinks 
09.
    ActiveWorkbook.BreakLink Name:=Link_3, Type:=xlExcelLinks 
10.
    ActiveWorkbook.BreakLink Name:=Link_4, Type:=xlExcelLinks 
11.
    ActiveWorkbook.BreakLink Name:=Link_5, Type:=xlExcelLinks 
12.
    ActiveWorkbook.BreakLink Name:=Link_5, Type:=xlExcelLinks 
13.
Next i 
14.
    
15.
ActiveWorkbook.Sheets(1).Activate 
16.
    
17.
End Function 
18.
 
19.
Function ReplacePath(OldPath As String, NewPath As String) 
20.
     
21.
   Cells.Replace What:=OldPath, Replacement:=NewPath, LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False 
22.
         
23.
End Function 
24.
 
25.
Sub Links_entfernen() 
26.
   
27.
Dim Suche_1 As String, Suche_2 As String, Suche_3 As String, Suche_4 As String, Suche_5 As String, Suche_6 As String 
28.
   
29.
Suche_1 = "D:\Pfad1" 
30.
Suche_2 = "D:\Pfad2" 
31.
Suche_3 = "D:\Pfad3" 
32.
Suche_4 = "D:\Pfad4" 
33.
Suche_5 = "D:\Pfad5" 
34.
Suche_6 = "D:\Pfad6" 
35.
 
36.
FOLDER_EXCELFILES = "D:\Test\" 
37.
     
38.
Set fso = CreateObject("Scripting.Filesystemobject") 
39.
Set folderExcelFiles = fso.GetFolder(FOLDER_EXCELFILES) 
40.
   
41.
For Each file In folderExcelFiles.Files 
42.
    ext = Right(file.Name, Len(file.Name) - InStrRev(file.Name, ".")) 
43.
     
44.
    If LCase(ext) = "xls" Or LCase(ext) = "xlsx" Then 
45.
        Dim doc As Workbook, Anzahl As Integer 
46.
        Debug.Print file.Path 
47.
        Set doc = Application.Workbooks.Open(file.Path, 0) 
48.
        Anzahl = doc.Sheets.Count 
49.
 
50.
        DeleteLink Anzahl, Suche_1, Suche_2, Suche_3, Suche_4, Suche_5, Suche_6 
51.
                       
52.
        Application.DisplayAlerts = False 
53.
        doc.Save 
54.
        doc.Close 
55.
        Application.DisplayAlerts = True 
56.
    End If 
57.
Next 
58.
 
59.
MsgBox "Vorgang beendet." 
60.
 
61.
End Sub
Das geht natürlich auch Bestens mit Ersetzen, wie du schon schriebst. Ich habe mir einfach beide Varianten in eine leere Arbeitsmappe gepackt.

Danke nochmal !!!

Gruß
Torsten
Bitte warten ..
Mitglied: goodbytes
17.10.2012, aktualisiert um 12:50 Uhr
Hallo Uwe,
es funktioniert jetzt prima. Aber Eines würde mich noch interessieren.

Um den Code knapper zu halten wäre es gut alle SVERWEISE auszulesen und wenn ein bestimmter Dateiname wie z.B. "Test.xls" darin vorkommt diesen SVERWEIS zu entfernen mittels ".BreakLink".

Ist so etwas auch möglich?

Gruß
Torsten
Bitte warten ..
Mitglied: colinardo
17.10.2012, aktualisiert um 13:06 Uhr
Na sicher geht das mit Regular Expressions kannst du das komfortabel erledigen:
Du musst aber zu deinem VBA Projekt folgenden Verweis hinzufügen (Menü Extras/Verweise...):
Microsoft VBScript Regualr Expressions 5.5

01.
Dim myRegExp, FoundMatch 
02.
Set myRegExp = New RegExp 
03.
myRegExp.IgnoreCase = True 
04.
myRegExp.Pattern = ".*Test.xls.*" 
05.
FoundMatch = myRegExp.Test("c:\Pfad\Test.xls")
Der Suchpattern wird in der vorletzten Zeile angegeben. In der letzten Zeile wird der Funktion der zu untersuchende String übergeben. Wenn der angegebene Pattern dazu passt gibt die Funktion True(Wahr) zurück, ansonsten False(Falsch).

Tutorials zu Regular Expressions findest du zu Hauf im Netz.

uwe
Bitte warten ..
Mitglied: goodbytes
17.10.2012 um 16:12 Uhr
Prima, ich werde es heute mal probieren.

Danke !!!

Gruß
Torsten
Bitte warten ..
Neuester Wissensbeitrag
Ähnliche Inhalte
Batch & Shell
gelöst For f - In vielen Dateien Komma durch Punkt ersetzen (2)

Frage von alleedx zum Thema Batch & Shell ...

Windows Server
Server sehr langsam bei vielen kleinen Dateien (5)

Frage von MichiBLNN zum Thema Windows Server ...

Microsoft Office
Mehr als 20 Excel Dateien öffnen gleichzeitig (7)

Frage von PizzaPepperoni zum Thema Microsoft Office ...

Heiß diskutierte Inhalte
Windows Userverwaltung
Ausgeschiedene Mitarbeiter im Unternehmen - was tun mit den AD Konten? (29)

Frage von patz223 zum Thema Windows Userverwaltung ...

Viren und Trojaner
Aufgepasst: Neue Ransomware Goldeneye verbreitet sich rasant (20)

Link von Penny.Cilin zum Thema Viren und Trojaner ...

LAN, WAN, Wireless
FritzBox, zwei Server, verschiedene Netze (20)

Frage von DavidGl zum Thema LAN, WAN, Wireless ...

Windows Netzwerk
Windows 10 RDP geht nicht (18)

Frage von Fiasko zum Thema Windows Netzwerk ...