1
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.
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
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 SubPS: 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
Share on Facebook
Share on Twitter
Share on Reddit
Share on LinkedinPlease also mark the comments that contributed to the solution of the article
Content-Key: 186354
Url: https://administrator.de/contentid/186354
Printed on: April 20, 2024 at 05:04 o'clock
1 Comment
Hallo BADwolf,
auf diese Art kannst du abfragen, ob ein Ordner existiert.
Dann noch entsprechend in deinen Script einbauen und auswerten.
Viele Grüße
Tsuki
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 aaDann noch entsprechend in deinen Script einbauen und auswerten.
Viele Grüße
Tsuki
