Direktfenster oder TXT-Datei? Problem damit.
24.05.2007 10:56:00
Andreas
ich habe zwei Prozeduren geschrieben, durch welche ein Ordner mit all seinen Exceldateien durchsucht wird. Dabei werden in das Direktfenster alle vorkommenden Verknüpfungen (siehe auch Bearbeiten -> Verknüpfungen ) geschrieben. Jetzt hab ich aber mitbekommen, dass das Direktfenster nur eine begrenzte Anzahl von Zeilen anzeigt. In den Fällen, wo mehr Verknüpfungen vorkommen, werden dann immer schon die ersten wieder gelöscht.
Kann man das irgendwo einstellen, dass mehr Zeilen angezeigt werden sollen? Wenn nicht, hab ich mir gedacht, das Problem über eine TXT-Datei zu lösen und die Verknüpfungen da hinein zu schreiben. Meine Versuche dazu sind aber alle gescheitert, denn das funktioniert in der rekursiven Prozedur nicht so leicht. Oder ich stell mich einfach zu dumm an!
Kann mir vielleicht jemand weiterhelfen?
Nachfolgend die beiden Prozeduren:
Option Explicit
Dim z As Long
' 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
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
Set wb = Workbooks.Open(xpath & "\" & xt(xi), 0, True)
aLinks = wb.LinkSources(xlExcelLinks)
If Not IsEmpty(aLinks) Then
' Zählvariable -> kann weggelassen werden
z = z + 1
For i = 1 To UBound(aLinks)
' Ausgabe der verwendeten Links im Direktfenster
Debug.Print aLinks(i)
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
' Aufrufprozedur zum Start
Sub test()
Application.ScreenUpdating = False
z = 0
' der hier angegebene Pfad wird mit all seinen Unterpfaden durchgegangen
xDirFile "C:\Test"
Application.ScreenUpdating = True
' Ausgabe der Zählvariable im Direktfenster
Debug.Print z
End Sub
Gruss
Andreas