Programm läuft nicht 100%ig richtig

Hallo,
folgendes Problem beschäftigt mich seit einigen Tagen und ich komm einfach nicht darauf, woran das liegen kann. Ich habe ein Programm, welches mir in einem frei festlegbaren Ordner die Exceldateien öffnet und dabei die Verknüpfungen ansieht. Kommen ganz bestimmte Verknüpfungen vor, so ändert das Programm automatisch diese. Handelt es sich um andere Verknüpfungen, wird die Datei geschlossen und zur nächsten gegangen. Bei den Dateien, wo Verknüpfungen geändert wurden, wird die Datei am Ende gespeichert und geschlossen.
Soweit die Theorie. In der Praxis sieht das so aus, dass es immer wieder Dateien gibt, bei denen die Verknüpfungen nicht geändert werden und ich weiß nicht woran das liegt. Ein Schreibschutz ist bei den Dateien nicht vorhanden.
Ein zweites Phänomen ist, dass einige Dateien gar nicht geschlossen werden. Woran das liegt, kann ich mir auch nicht erklären, denn die restlichen 98 Prozent der Dateien werden doch auch geschlossen.
Kann mir vielleicht jemand weiterhelfen? Danke schon einmal im Voraus.
Gruß
Andreas

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Hallo Tino, hier der wichtigste Teil des Programms:
Option Explicit
Dim z As Long
' Aufrufprozedur zum Start
Sub start()
Application.ScreenUpdating = False
z = 0
' der hier angegebene Pfad wird mit all seinen Unterpfaden durchgegangen
xDirFile "C:\PROJEKTE\Test"
Application.ScreenUpdating = True
' Ausgabe der Zählvariable im Direktfenster
' wird sonst nicht benötigt
'Debug.Print z
End Sub

' 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
'Aufgaben, die zu erledigen sind
'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
' nur Ersetzungvorschrift
' diese Funktion steht im Modul "Referenzen"
NEUVERLINKEN aLinks, wb
End If
' Schreiben der Links in das Direktfenster
'Debug.Print xpath & "\" & xt(xi)
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

Gruss
Andreas

Beliebteste Forumthreads (12 Monate)

Programm läuft nicht 100%ig richtig

3 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

3
Beiträge zum Forumthread

Beiträge zu diesem Forumthread