ich hab eine rekursive Prozedur, in welcher eine Ersetzungsschleife (Ersetzung von Teilen von Verknüpfungen) eingebaut ist. Da es sich letztendlich um viele Ersetzungen handeln wird, möchte ich das gern übersichtlicher gestalten. Als Lösungen schwebt mir da vor, die Ersetzungsschleife in ein separates Modul auszulagern oder vielleicht besser noch die Ersetzungsteile (alte und neue Version) in einer separaten Datei (Excel, txt, ) auszulagern.
Die Variante mit dem extra Modul hab ich bereits versucht, aber die funktioniert nicht, weil ich nicht weiß, welche Parameter ich mit übergeben muss und wie ich das dann schreiben muss, denn die rekursive Prozedur muss immer so weiter funktionieren.
Zu der Variante mit der separaten Datei habe ich gar keine Idee, wie das umgesetzt werden könnte.
Kann mir vielleicht jemand weiter helfen?
Hier noch die rekursive Prozedur:
Public Sub xDirFile(xpath As String)
Dim xa As Long
Dim xDir As String
ReDim xt(0) As String
Dim xi As Long
Dim xAc As String
Dim wb As Workbook
Dim aLinks
Dim i As Integer
Dim newlink As String
' Zulassen von allen Formen von Dateien
' schreibgeschützte, versteckte, Systemdateien, Verzeichnisse, Ordner, ...
xDir = Dir(xpath & "\*.*", vbNormal Or vbReadOnly Or vbHidden _
Or vbSystem Or vbVolume Or vbDirectory Or vbArchive)
xa = 0
If Len(xDir) > 0 Then
xt(0) = xDir
End If
Do While Len(xDir) > 0
xDir = Dir
If Len(xDir) > 0 And Not xDir = "." And Not xDir = ".." Then
xa& = xa& + 1
ReDim Preserve xt(xa)
xt(xa) = xDir
End If
Loop
On Error GoTo Schleife
For xi& = 0 To xa&
If Len(xt(xi)) = 0 Then
Exit For
ElseIf Not xt(xi) = "." And Not xt(xi) = ".." Then
If Len(Dir$(xpath$ & "\" & xt$(xi&), vbNormal Or vbReadOnly Or vbHidden _
Or vbSystem Or vbVolume Or vbDirectory Or vbArchive)) > 0 Then
If Not (GetAttr(xpath & "\" & xt(xi)) And vbDirectory) = vbDirectory Then
'wenn Exceldatei
If UCase(Right(xt(xi), 3)) = "XLS" Then
'Debug.Print xpath & "\" & xt(xi)
' die "0" bedeutet, dass die Frage nach der Aktualisierung
' von Verlinkungen verneint wird
Set wb = Workbooks.Open(xpath & "\" & xt(xi), 0)
aLinks = wb.LinkSources(xlExcelLinks)
If Not IsEmpty(aLinks) Then
' Zählvariable -> kann weggelassen werden
z = z + 1
For i = 1 To UBound(aLinks)
' Schleife, die für die Ersetzungen zuständig ist
' Hier müssen alle zu ersetzenden Verknüpfungen aufgelistet sein
' --> neuer Verknüpfungsanfang muss demenstprechend ebenfalls angegeben _
werden
If Left(aLinks(i), 21) = "D:\Berichte\2005\alt\" Then
newlink = Replace(aLinks(i), "I:\Projekt\alt\2005\", _
"D:\neu\Berichte\2005\---\", , , vbTextCompare)
wb.ChangeLink aLinks(i), newlink, xlLinkTypeExcelLinks
wb.Save
ElseIf Left(aLinks(i), 21) = "D:\Berichte\2005\neu\" Then
newlink = Replace(aLinks(i), "I:\Projekt\neu\2005\", _
"D:\neu\Berichte\2005\---\", , , vbTextCompare)
wb.ChangeLink aLinks(i), newlink, xlLinkTypeExcelLinks
wb.Save
ElseIf Left(aLinks(i), 21) = "D:\Berichte\2006\alt\" Then
newlink = Replace(aLinks(i), "I:\Projekt\alt\2006\", _
"D:\neu\Berichte\2006\---\", , , vbTextCompare)
wb.ChangeLink aLinks(i), newlink, xlLinkTypeExcelLinks
wb.Save
End If
Next i
End If
wb.Close savechanges:=False
Set wb = Nothing
End If
Else
Call xDirFile(xpath & "\" & xt(xi))
End If
End If
End If
Schleife:
Next xi&
On Error GoTo 0
End Sub
Danke und Gruss
Andreas