juckie
May 28, 2014, updated at 12:39:04 (UTC)
view6844
view11
0
Goto Top

VBA Script - Pfade zu Dokumentevorlagen anpassen

GermansolvedQuestionVB for ApplicationsDevelopment
Guten Morgen an alle,

wir haben unser zentrales Dokumentenverzeichnis auf einen anderen Server umgezogen. Nun befinden sich in dem Dokumentenverzeichnis Word Dokumente die mit Vorlagen verknüpft sind, welche in dem Dokumentenverzeichnis liegen. Der Servername ist jedoch nicht der gleiche. Das Resultat ist nun, dass das Öffnen eines Word-Dokumentes relativ lange dauert, da der Pfad zur Dokumentenvorlage, mit welchem das Word-Dokument verknüpft ist, nicht mehr existiert. Umbenennen des Servers ist leider nicht möglich. Ich weiß, dass es ungünstig ist, Vorlagen auf einem Serverlaufwerk zu speichern, jedoch ist das, ich sag mal, historisch so gewachsen.

Ich habe nun hier im Forum ein Script gefunden, welches zwar den Pfad zur verknüpften Dokumentenvorlage entfernt, jedoch ist das nicht genau das, was ich benötige.

Das Ziel sollte sein, den Pfad zur verknüpften Dokumentenvorlage zu ändern. Leider bekomme ich es irgendwie nicht, da meine Kenntnisse in VBA praktisch 0 sind. Könnte von euch vielleicht jemand einen Blick auf das Skript werfen und mir sagen, an welcher Stelle ich da ansetzen muss.

Vielen Dank im Voraus

'Pfad zu den Dokumenten  
Const strPathDocs = "C:\temp\0003\test"  
'Logfile für eventuell auftretende Fehler  
Const strPathLogfile = "C:\temp\0003\test\logfile.txt"  
'Alter Servername  
strOldServer = "\\1.1.1.1\dok"  

Set fso = WScript.CreateObject("Scripting.Filesystemobject")  
Set objWord = WScript.CreateObject("Word.Application")  
'Wenn das ganze unsichtbar ablaufen soll nächste Zeile auf false setzen  
objWord.Visible = True
objWord.DisplayAlerts = 0
'Im Ordner Rekursiv alle Word-Dokumente verarbeiten  
parseFolders fso.GetFolder(strPathDocs), False
objWord.DisplayAlerts = -1
objWord.Quit True
Set fso = Nothing
Set objWord = Nothing

Function parseFolders(fldr, boolRecursion)
    
    For Each file In fldr.Files
        'Verarbeite nur Dateien mit den Endungen *.doc, *.docx, *.docm  
        If LCase(Right(file.Name, 3)) = "doc" Or LCase(Right(file.Name, 4)) = "docx" Or LCase(Right(file.Name, 4)) = "docm" Then  
            On Error Resume Next
            If Err.Number <> 0 Then
                Set objLog = fso.OpenTextFile(strPathLogfile, 3, True)
                objLog.WriteLine ("Fehler beim öffnen der Datei: -> " & file.Path)  
                objLog.Close
            Else
        Set dlgTemplate = Application.Dialogs(87)
        If InStr(1, dlgTemplate.Template, strOldServer, 1) Then
            Set objDoc = objWord.Documents.Open(file.Path)
            Set attTmpl = objDoc.AttachedTemplate.Path
            MsgBox ActiveDocument.AttachedTemplate
            'Dim attTmpl as String = objDoc.AttachedTemplate  
            attTmpl = Replace(attTmpl, "\\1.1.1.1\dok", "\\1.1.1.2\dok")  
            objDoc.AttachedTemplate = attTmpl
            objDoc.Save
            objDoc.Close True
        Else
            objDoc.Close False
        End If
            End If
        End If
    Next
    
    If boolRecursion Then
        For Each subFolder In fldr.SubFolders
            parseFolders subFolder, True
        Next
    End If
End Function

Gruß

Juckie
comment-contentCommentShareShare
Share on Facebook Share on Twitter Share on Reddit Share on Linkedin

Content-Key: 239435

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

Printed on: April 24, 2024 at 16:04 o'clock

11 Comments
Latest comment
Goto Top
Mitglied: 116301
116301 May 28, 2014 at 07:32:53 (UTC)
Goto Top
Hallo Juckie!

Soweit ich das sehe, brauchst nur in Codezeile 37 für das erste String-Argument den alten Pfad und für das zweite String-Argument den neuen Pfad bzw. nur den zu ersetzenden Teil anzugeben...

Grüße Dieter
Member: Juckie
Juckie May 28, 2014 at 07:52:54 (UTC)
Goto Top
Hallo,

das müsste ja in der Zeile 37 so passen.

Was ich nicht gebacken bekomme ist, dass er mir den Pfad zur verknüpften Dokumentenvorlage nicht ausliest. Egal was ich versuche, ich erhalte in meiner MsgBox Ausage in Zeile 35 entweder eine leere Ausgabe oder aber den Pfad zu meiner lokalen Dokumentenvorlage Normal.dot, aber nicht den Pfad, der im aktuell geöffenten Word Dokument unter Registerkarte Entwicklertools / Dokumentvorlage / Vorlage hinterlegt ist.

Was mache ich falsch?

Gruß

Juckie
Member: colinardo
Solution colinardo May 28, 2014 updated at 12:39:27 (UTC)
Goto Top
Moin Juckie,
Zitat von @Juckie:
Was mache ich falsch?
Ihr habt ja auch mein Script mit euren Abänderungen total durcheinander gebracht!
Zur Info das ist ein VBS- und kein VBA-Script ... und sollte auch aus einem VBS-Script aus ausgeführt werden.
so sollte es laufen...
'Pfad zu den Dokumenten  
Const strPathDocs = "C:\temp\0003\test"  
'Logfile für eventuell auftretende Fehler  
Const strPathLogfile = "C:\temp\0003\test\logfile.txt"  
'Alter Servername  
Const strOldServer = "\\1.1.1.1\dok"  
'Neuer Servername  
Const strNewServer = "\\1.1.1.2\dok"   

Set fso = Wscript.CreateObject("Scripting.Filesystemobject")  
Set objWord = WScript.CreateObject("Word.Application")  
'Wenn das ganze unsichtbar ablaufen soll nächste Zeile auf false setzen  
objWord.Visible = True
objWord.DisplayAlerts = 0
'Im Ordner Rekursiv alle Word-Dokumente verarbeiten  
parseFolders fso.GetFolder(strPathDocs), True
objWord.DisplayAlerts = -1
objWord.Quit True
Set fso = Nothing
Set objWord = Nothing

Function parseFolders(fldr, boolRecursion)
  For Each file In fldr.Files
    'Verarbeite nur Dateien mit den Endungen *.doc, *.docx, *.docm  
    If LCase(Right(file.Name, 3)) = "doc" Or LCase(Right(file.Name, 4)) = "docx" Or LCase(Right(file.Name, 4)) = "docm" Then  
      On Error Resume Next
      Set objDoc = objWord.Documents.Open(file.Path)
      'Falls ein Fehler aufgetreten ist, schreibe dies ins Logfile  
      If Err.Number <> 0 Then
        Set objLog = fso.OpenTextFile(strPathLogfile,8,True)
        objLog.WriteLine("Fehler beim öffnen der Datei: -> " & file.Path)  
        objLog.Close
      Else
        Set dlgTemplate = objWord.Dialogs(87)
        ' Wenn der alte Serverpfad in der Vorlage gefunden wurde, starte Ersetzung der Vorlage  
        If InStr(1,dlgTemplate.Template,strOldServer,1) Then
          'neuen Vorlagenpfad erstellen  
          newTemplate = Replace(dlgTemplate.Template,strOldServer,strNewServer,1,1,1)
          ' Entfernen der Vorlageninformationen  
          objDoc.RemoveDocumentInformation (9)
          ' neue Vorlage zuweisen  
          objDoc.AttachedTemplate = newTemplate
          ' Dokument speichern und schließen  
          objDoc.Save
          objDoc.Close True
        Else
          ' Dokument schließen und nicht speichern  
          objDoc.Close False
        End If
      End If
    End if
  Next
    
  If boolRecursion Then
    For Each subFolder in fldr.SubFolders
      parseFolders subFolder, True
    Next
  End If
End Function
Grüße Uwe
Member: Juckie
Juckie May 28, 2014 updated at 08:59:08 (UTC)
Goto Top
Moin Uwe,

ja, ich habe dein Skript ein wenig abgeändert face-wink Sorry, aber VB ist echt nicht meine Welt.

Ich habe dein abgeändertes Skript vom vorigen Post 1:1 übernommen, nur leider setzt er mir den geänderten Pfad zur verknüpften Dokumentevorlage immer noch nicht. In dem Feld unter Entwicklertools -> Dokumentvorlage -> Vorlagen steht Normal drin.

Wenn ich in Zeile 36 ein

MsgBox objDoc.AttachedTemplate.Name

einfüge, erhalte ich als Ausgabe

Normal.dotm

und da sollte eigentlich \\1.1.1.1\dok... drinstehen.

Könntest du evtl. nochmal kurz drüber schauen? Das wäre klasse.

Vielen Dank

Gruß Juckie
Member: colinardo
Solution colinardo May 28, 2014 updated at 12:39:20 (UTC)
Goto Top
Zitat von @Juckie:
Könntest du evtl. nochmal kurz drüber schauen? Das wäre klasse.
hatte noch kurz was abgeändert, hier läuft es einwandfrei. Du solltest auch beachten das du keine neue *.dotx-Vorlage an ein altes *.doc anhängen kannst, das funktioniert nicht !

Grüße Uwe
Member: colinardo
Solution colinardo May 28, 2014 updated at 12:39:18 (UTC)
Goto Top
Zitat von @Juckie:
und da sollte eigentlich \\1.1.1.1\dok... drinstehen.
nein, der komplette Name mit Pfad wird hier zusammengebaut :
objDoc.AttachedTemplate = Replace(objDoc.AttachedTemplate.Path,strOldServer,strNewServer,1,1,1) & "\" & objDoc.AttachedTemplate.Name
Du verwechselst hier Dinge...
Member: Juckie
Juckie May 28, 2014 at 09:15:37 (UTC)
Goto Top
Hallo Uwe,

gebe ich in Zeile 36 ein

MsgBox objDoc.AttachedTemplate.Path

erhalte ich als Ausgabe den Pfad zu meinen Benutzervorlagen der im Word auch unter Datei -> Optionen -> Erweitert -> Dateispeicherorte hinterlegt ist, was aber nicht dem Pfad entspricht, der in dem Dokument hinterlegt ist.

Mir kommt es so vor, als wäre das Objekt objDoc nicht das geöffnete Dokument.

Gruß

Juckie
Member: colinardo
Solution colinardo May 28, 2014 updated at 12:39:08 (UTC)
Goto Top
Zur Info: Zum Anpassen der Dokumente sollte der alte Pfad vorübergehend zur Verfügung gestellt werden. Wie sich das machen lässt habe ich in diesem Beitrag geschrieben: Alte Server Verknüpfung bei Clients löschen
man kann das ganze zwar in Zeile 36 so abändern:
objDoc.AttachedTemplate = Replace(dlgTemplate.Template,strOldServer,strNewServer,1,1,1)
aber so bleiben noch interne Verweise zum alten Server erhalten.

Also besser den alten Server-Pfad dem Client zur Verfügung stellen.

Grüße Uwe
Mitglied: 116301
Solution 116301 May 28, 2014 updated at 12:39:12 (UTC)
Goto Top
Hallo zusammen!

Nur der Vollständigkeit halber:
Name: Enthält nur Name
Path: Enthält nur den Ordnerpfad
FullName: Enthält den vollständigen Pfad

Grüße Dieter
Member: colinardo
Solution colinardo May 28, 2014 updated at 12:39:04 (UTC)
Goto Top
So, habe das ganze in deinem Fall mal analysiert und habe oben den Code entsprechend abgeändert. Damit sollte es jetzt funktionieren. Hier mit einem deiner Testdokumente erfolgreich getestet.
Es wird nun zusätzlich mit objDoc.RemoveDocumentInformation (9) die Vorlagenreferenz entfernt bevor die neue Dokumentvorlage zugewiesen wird.

Grüße Uwe
Member: Juckie
Juckie May 28, 2014 at 12:38:34 (UTC)
Goto Top
Hallo Uwe,

perfekt, jetzt macht es das, was es machen soll.

Super, tausend Dank an Dich!

Gruß

Juckie
GermansolvedQuestionVB for ApplicationsDevelopment
Hotly discussed
gleixnerdCheck of ZFW Firewallgleixnerd - 5 CommentsjstrickerWireguard VPN on UDM Pro behind Fritzbox - Handshake did not completejstricker - 3 CommentsAlexWishaHow to set up and configure a Linux GRE tunnelAlexWisha - 3 Comments