Verknüpfungen mit vba ändern
Gerd Welzel
in der Arbeitsmappe "QuelleAendern.xls" habe ich in einem Tabellenblatt in
Zelle B1 den Pfad "d:\Eigene Dateien\Test" stehen.
In diesem Verzeichnis sind viele xls-Dateien mit Verknüpfungen zu einer
Quelldatei abgelegt. Der Pfad der Quelldatei hat sich im Laufe der Zeit
einige Male durch verschieben in andere Ordner geändert, sodaß einige
Dateien den Quelldateipfad "x" haben, andere Dateien den Quelldateipfad "y".
Jetzt mußte die Quelldatei nochmals in einen anderen Ordner gelegt werden.
War leider unumgänglich.
Mit nachfolgendem code in einem Modul einer Arbeitsmappe möchte ich
folgendes erreichen:
Nacheinander soll jede Arbeitsmappe im Pfad "d:\Eigene Dateien\Test"
geöffnet werden, der Blattschutz in allen Tabellenblättern entfernt werden
und der Pfad der verknüpften Quelldatei geändert werden. Das funktioniert
aber nicht. Es werden zwar nacheinander alle Arbeitsmappen geöffnet und der
Blattschutz entfernt und am Schluß wieder gesetzt, aber der Pfad der
verknüpften Quelldatei wird nicht geändert.
Was ist falsch an diesem code???
Sub QuelleAendern1()
Dim iCounter As Integer
Dim iWks As Integer
Dim iWks1 As Integer
Dim alinks
Application.ScreenUpdating = False
Application.EnableEvents = False
On Error GoTo ERRORHANDLER
With Application.FileSearch
.LookIn = Range("B1").Value
.FileType = msoFileTypeExcelWorkbooks
.Execute
For iCounter = 1 To .FoundFiles.Count
Workbooks.Open .FoundFiles(iCounter), False
For iWks = 1 To Worksheets.Count
Worksheets(iWks).Unprotect "Passwort"
Next iWks
alinks = ActiveWorkbook.LinkSources(xlOLELinks)
'Die vorherige Zeile "alinks = ActiveWorkbook.LinkSources(xlOLELinks)" wird
noch abgearbeitet, danach wird sofort zu "End if" gesprungen.
If Not IsEmpty(alinks) Then
ActiveWorkbook.ChangeLink Name:="D:\Eigene
Dateien\AlterPfad\Adressen.xls", _
NewName:="D:\Eigene Dateien\NeuerPfad\Adressen.xls",
Type:=xlExcelLinks
End If
ERRORHANDLER:
Application.EnableEvents = True
Application.ScreenUpdating = True
For iWks1 = 1 To Worksheets.Count
Worksheets(iWks1).Protect "Passwort"
Next iWks1
ActiveWorkbook.Close savechanges:=True
Next iCounter
End With
End Sub
Umgebung: win98SE, xl9
Für Eure Hilfe im voraus herzlichen Dank!!!
--
Mit freundlichen Grüßen
Gerd Welzel
Gerd Welzel
das Problem ist Dank Frank Arendt-Theilen gelöst!!!!!!!!!!!
Gerd Welzel
klar mache ich das :-)
Hier der funktionierende cod (mußt Du für Dich eventuel noch anpassen):
Sub QuelleAendern()
'Dieser code bewirkt, daß in allen Tabellenblättern alle ".xls-Dateien"
'eines bestimmten Pfades(muß angegeben werden im Tabellenblatt in Zelle B1)
'der Blattschutz aufgehoben, und nachdem der Pfad der verknüpften Quelldatei
'geändert wurde, der Blattschutz wieder gesetzt wird.
'Vorrangig ist die Änderung des Pfades der verknüpften Quelldatei für alle
'xls-Dateien eines vorgegebenen Verzeichnisses.
Dim iCounter As Integer
Dim i As Integer
Dim iWks As Integer
Dim iWks1 As Integer
Dim alinks
Dim quelle As String
Application.ScreenUpdating = False
Application.EnableEvents = False
On Error GoTo ERRORHANDLER
'Die xls-Dateien im Pfad, der in der Tabelle in Zelle B1 steht, werden
gesucht.
With Application.FileSearch
.LookIn = Range("B1").Value
.FileType = msoFileTypeExcelWorkbooks
.Execute
'Die xls-Dateien im Pfad aus Zelle B1 werden gezählt und die erste
'gefundene Arbeitsmappe wird geöffnet.
For iCounter = 1 To .FoundFiles.Count
Workbooks.Open .FoundFiles(iCounter), False
'In dieser Schleife wird in allen Tabellenblättern der Blattschutz
entfernt.
For iWks = 1 To Worksheets.Count
Worksheets(iWks).Unprotect "DeinPasswort"
Next iWks
'Der Variablen "alinks" wird der Pfad der verknüpften Quelldatei
der
'aktiven Mappe zugeordnet.
alinks = ActiveWorkbook.LinkSources(xlExcelLinks)
'Wenn "alinks" nicht leer ist, wird der Pfad in Zelle A1 der
aktiven
'Mappe geschrieben.
If Not IsEmpty(alinks) Then
For i = 1 To UBound(alinks)
ActiveWorkbook.Worksheets("Deckblatt").Range("A" &
i).Value = alinks(i)
Next i
End If
'Der Variablen "quelle" wird der Pfadname aus Zelle A1
übergeben.
quelle =
ActiveWorkbook.Worksheets("Deckblatt").Range("A1").Value
'Der Pfad der verknüpften Quelldatei wird geändert
If ActiveWorkbook.Worksheets("Deckblatt").Range("A1").Value <> _
"D:\Eigene Dateien\mf\Vernüpfungen\Adressen.xls" Then
ActiveWorkbook.ChangeLink name:=quelle, _
NewName:="D:\Eigene Dateien\mf\Verknüpfungen\Adressen.xls",
Type:=xlExcelLinks
'Hier wird die Verknüpfung aktuallisiert.
ActiveWorkbook.UpdateLink name:= _
"D:\Eigene Dateien\mf\Verknüpfungen\Adressen.xls", Type:=xlExcelLinks
Else
End If
'Inhalt der Zelle A1 wird gelöscht.
ActiveWorkbook.Worksheets("Deckblatt").Range("A1").ClearContents
'In dieser Schleife wird in allen Tabellenblättern der Blattschutz
gesetzt.
For iWks1 = 1 To Worksheets.Count
Worksheets(iWks1).Protect "DeinPasswort"
Next iWks1
'Arbeitsmappe wird geschlossen und gespeichert
ActiveWorkbook.Close savechanges:=True
Next iCounter
ERRORHANDLER:
Application.EnableEvents = True
Application.ScreenUpdating = True
End With
End Sub
Falls Du noch Fragen hast, melde Dich bei mir per mail. ger...@gmx.de
--
Mit freundlichen Grüßen
Gerd Welzel
"Peter Veith" <Peter...@procosoft.de> schrieb im Newsbeitrag
news:aqvnhs$g7u$04$1...@news.t-online.com...
> Hallo Gerd,
> ich habe das gleiche (oder ähnliche) Problem und wäre sehr interessiert
von
> Dir zu erfahren, wie Du es gelöst hast.
>
> Kannst Du den funktionierenden Code angeben etwa wie in Deinem ersten
> Posting?
>
> Danke
> Peter Veith
Peter Veith
ich habe das gleiche (oder ähnliche) Problem und wäre sehr interessiert von
Dir zu erfahren, wie Du es gelöst hast.
Kannst Du den funktionierenden Code angeben etwa wie in Deinem ersten
Posting?
Danke
Peter Veith
"Gerd Welzel" <ger...@gmx.de> schrieb im Newsbeitrag
news:eylOj3yiCHA.2596@tkmsftngp10...
Peter Veith
vielen Dank für den Code. Hat mir viel genützt!
Peter Veith