VBA - Korrupte Vorlagendateipfad ändern

entwurf eines VBA Scripts,

Hallo, ich habe ein verzeichnis mit vielen Word dateien bei denen viele Vorlagenpfade nicht mehr stimmen. Dadurch benötigt Word für das öffnender Dateien länger, was natürlich dann irgendwann auch zuviel Zeit kostet. Nun habe ich ein Script geschrieben welche ALLE vorlagenpfade im ausgesuchtem Verzeichnis verändert. Was zwar seinen Zweck erfüllt, aber auch eher suboptimal ist. Denn nicht alle Vorlagenpfade sind corrupt. Also würde ich gerne eine if abfrage einbauen die abfragt, ob der Verzeichnispfad vorhanden ist, und wenn nicht, dann wie im Script, verfahren soll, also dem Dokument das Standard normal.dot als vorlage geben soll.

Bin nun aber schon sehr lange mit der if abfrage beschäftigt und bekomme es nicht hin.

Sub Document_Open()
  Dim AppShell As Object
  Dim BrowseDir As Variant
  Dim Pfad As String
  Set AppShell = CreateObject("Shell.Application")  
  Set BrowseDir = AppShell.BrowseForFolder(0, "Ordner auswählen", &H1000, 17)  
  On Error Resume Next
  Pfad = BrowseDir.items().Item().Path
  If Pfad = "" Then Exit Sub  
' Allen Dateien eines Verzeichnisses eine andere Dokumentvorlage zuweisen  
    With Application.FileSearch
                    .NewSearch
                    .FileName = "*.doc"  
                    .LookIn = Pfad
                    .SearchSubFolders = False
                    If .Execute() > 0 Then
                        ReDim strdateien(.FoundFiles.Count)
                        ReDim strZugehOrdner(.FoundFiles.Count)
                    Application.DisplayAlerts = False
      'Durchläuft alle Dateien, die in dem obigen Verzeichnis vorhanden sind.  
                        For i = 1 To .FoundFiles.Count
                            strdateien(i) = .FoundFiles(i)
                            strZugehOrdner(i) = .FoundFiles(i)
                            Do
                                strdateien(i) = Right(strdateien(i), (Len(strdateien(i)) - InStr(strdateien(i), "\")))  
                                Loop While InStr(strdateien(i), "\") > 0  
                                Documents.Open FileName:=strZugehOrdner(i)
                                Vorlage = ActiveDocument.AttachedTemplate.FullName
                                With ActiveDocument
                                    .AttachedTemplate = "%userprofile%\Anwendungsdaten\Microsoft\Vorlagen\Normal.dot"  'ordnet die Vorlage "normal.dot" zu  
                                    .Save '  
                                    .Close
                                End With
                        Next i
                    End If
    End With
End Sub

PS: generell würde es zwar reichen eine kürzere "Faildovertime" zu generieren. Was ich aber auch nicht wirklich schaffe...

Wäre super wenn mir jemand helfen könnte/würde

working with: Office 2000
working on: Windows XP

Bitte markiere auch die Kommentare, die zur Lösung des Beitrags beigetragen haben

Content-ID: 186354

Url: https://administrator.de/contentid/186354

Ausgedruckt am: 19.11.2024 um 01:11 Uhr

1 Kommentar

Hallo BADwolf,

auf diese Art kannst du abfragen, ob ein Ordner existiert.

Pfad =  "D:\00"  

Set fs = CreateObject("Scripting.FileSystemObject")  

If fs.FolderExists(Pfad) Then
      aa = "Das Verzeichnis '" & Pfad & "' existiert!"  
Else
      aa = "Verzeichnis '" & Pfad & "' nicht gefunden!"  
End If

msgbox aa