Documentos que possuem modelos anexados levar muito tempo para abrir no Word 2002 e no Word 2003

• O modelo anexado, sua pasta ou sua cota está ausente.
• O modelo anexado foi movido.
• O modelo anexado foi renomeado.

Voltar para o início | Submeter comentários

• Method 1: Attach the template from a new location, or attach the global template (Normal.dot).
• Method 2: Use a custom Visual Basic Application to change the attached template to the global template (Normal.dot ) when a new document is opened.
• Method 3: Create a Microsoft Visual Basic for Applications (VBA) macro that loops through all the documents in a folder and changes the old server name with the new server name
• Method 4: Create a VBA Macro that loops through all the documents in a folder and changes the old server name with the global template (Normal.dot )
• Method 5: Rename the server, the share, or the folder to the original name

Método 1: Anexar o modelo de um novo local

1. No menu Ferramentas, clique em modelos e suplementos.
2. Na caixa de diálogo modelos e suplementos, clique em Anexar.
3. Na caixa de diálogo Anexar modelo, selecione o modelo desejado e, em seguida, clique em Abrir.
4. Na caixa de diálogo modelos e suplementos, clique em OK.

Método 2: Usar um aplicativo personalizado do Visual Basic para alterar o modelo anexado ao modelo global (normal.dot) quando um novo documento é aberto

1. Abra um novo projeto Standard.exe.
2. Em um formulário do usuário, adicione os seguintes componentes:
   • Caixa de um listagem
   • Duas caixas de texto
   • Quatro botões de comando
   • Dois rótulos
3. Definir uma referência ao Microsoft Scripting Runtime (Scrun.dll).
4. Copy and paste the following code in a user form:

   Option Explicit
   
   Private Const BIF_RETURNONLYFSDIRS = 1
   Private Const BIF_DONTGOBELOWDOMAIN = 2
   Private Const MAX_PATH = 260
   Private Declare Function SHBrowseForFolder Lib "shell32" _
      (lpbi As BrowseInfo) As Long
   Private Declare Function SHGetPathFromIDList Lib "shell32" _
      (ByVal pidList As Long, _
      ByVal lpBuffer As String) As Long
   Private Declare Function lstrcat Lib "kernel32" Alias "lstrcatA" _
      (ByVal lpString1 As String, ByVal _
      lpString2 As String) As Long
   
   Private Type BrowseInfo
      hWndOwner      As Long
      pIDLRoot       As Long
      pszDisplayName As Long
      lpszTitle      As Long
      ulFlags        As Long
      lpfnCallback   As Long
      lParam         As Long
      iImage         As Long
   End Type
   
   Public fso As New FileSystemObject
   Dim fld As Folder
   
   Private Sub cmdEnd_Click()
      End
   End Sub
   
   Private Sub cmdSource_Click()
      ' Opens a Treeview control that displays the directories in a computer.
   
      Dim lpIDList As Long
      Dim sBuffer As String
      Dim szTitle As String
      Dim tBrowseInfo As BrowseInfo
   
      szTitle = "This is the title"
      With tBrowseInfo
         .hWndOwner = Me.hWnd
         .lpszTitle = lstrcat(szTitle, "")
         .ulFlags = BIF_RETURNONLYFSDIRS + BIF_DONTGOBELOWDOMAIN
      End With
   
      lpIDList = SHBrowseForFolder(tBrowseInfo)
      If (lpIDList) Then
         sBuffer = Space(MAX_PATH)
         SHGetPathFromIDList lpIDList, sBuffer
         sBuffer = Left(sBuffer, InStr(sBuffer, vbNullChar) - 1)
         frmFSO.txtSearch.Text = sBuffer
      End If
   End Sub
   
   Private Sub cmdTarget_Click()
   
      ' Opens a Treeview control that displays the directories in a computer.
   
       Dim lpIDList As Long
       Dim sBuffer As String
       Dim szTitle As String
       Dim tBrowseInfo As BrowseInfo
   
       szTitle = "This is the title"
       With tBrowseInfo
          .hWndOwner = Me.hWnd
          .lpszTitle = lstrcat(szTitle, "")
          .ulFlags = BIF_RETURNONLYFSDIRS + BIF_DONTGOBELOWDOMAIN
       End With
   
       lpIDList = SHBrowseForFolder(tBrowseInfo)
   
       If (lpIDList) Then
          sBuffer = Space(MAX_PATH)
          SHGetPathFromIDList lpIDList, sBuffer
          sBuffer = Left(sBuffer, InStr(sBuffer, vbNullChar) - 1)
       End If
   End Sub
   
   Private Sub Command1_Click()
      Dim nDirs As Long, nFiles As Long, lSize As Currency
      Dim sDir As String, sSrchString As String
      Dim nTime
      Dim ntime2
      Dim nOk As Integer
      Dim fileNumber As Integer
      Dim oWord As Object
      Dim strServer As String
      Set oWord = CreateObject("Word.Application")
      strServer = txtOldServer.Text
      nTime = Time()
      fileNumber = FreeFile
          
      List1.Clear
          
      Open "C:\ChangeTemplate.log" For Append As #fileNumber
      Write #fileNumber, "Start:" & " " & nTime
      Close #fileNumber
                    
      'Enter the top-level directory to start the search.
      sDir = txtSearch.Text
    
     'Enter the type of files, such as *.doc for Word documents
     sSrchString = "*.doc"
      
     MousePointer = vbHourglass
   
    'The label shows the current subfolder being searched.
     Label1.Caption = "Searching Folder: " & vbCrLf & UCase(sDir) & "..."
     lSize = FindFile(sDir, sSrchString, nDirs, nFiles, strServer, oWord)
     MousePointer = vbDefault
     ntime2 = Time()
     'Opens text file to show the stop time and the total numbers of
     'files that were found.
     Open "C:\ChangeTemplate.log" For Append As #fileNumber
     Write #fileNumber, "Stop:" & " " & ntime2 & " " & _
        "Time to Complete the Changes: " & _
        Format(ntime2 - nTime, "nn:ss") & vbCrLf _
        & Str(nFiles) & " files found in" & Str(nDirs) & _
        " directories"
     Close #fileNumber
     ' Debug.Print "Stop:" & " " & ntime2
     Label1.Caption = "Done"
     If Label1.Caption = "Done" Then Command2.Enabled = True
        MsgBox "Done"
        oWord.Quit
        Set oWord = Nothing
   End Sub
   
   Private Function FindFile(ByVal sFol As String, sFile As String, _
      nDirs As Long, nFiles As Long, strOServer As String, oWrd As Object) _
         As Currency
      Dim tFld As Folder, tFil As File, FileName As String
      Dim strFileName As String
      Dim fileNumber As Integer
         
      On Error GoTo Catch
        
      Set fld = fso.GetFolder(sFol)
      FileName = Dir(fso.BuildPath(fld.Path, sFile), vbNormal Or _
         vbHidden Or vbSystem Or vbReadOnly)
      While Len(FileName) <> 0
         FindFile = FindFile + FileLen(fso.BuildPath(fld.Path, FileName))
         nFiles = nFiles + 1
         List1.AddItem fso.BuildPath(fld.Path, FileName)  ' Load ListBox
         strFileName = fld.Path & "\" & FileName
         '==
           
         ChangeTemplate strFileName, strOServer, oWrd
         FileName = Dir()  ' Get next file
         DoEvents
      Wend
      Label1 = "Searching " & vbCrLf & fld.Path & "..."
      nDirs = nDirs + 1
   
      If fld.SubFolders.Count > 0 Then
         For Each tFld In fld.SubFolders
            DoEvents
            FindFile = FindFile + FindFile(tFld.Path, sFile, nDirs, nFiles, _
               strOServer, oWrd)
         Next
      End If
   Exit Function
   
   Catch:     FileName = ""
       
      If Err.Number = 76 Then
         MsgBox "This is not a valid path statement" & vbCrLf & _
            "The program will end!"
         End
      End If
      Debug.Print Err.Description
      fileNumber = FreeFile
   
      'Writes the error description and number to the log file.
      Open "C:\ChangeTemplate.log" For Append As #fileNumber
      Write #fileNumber, Err.Description & " " & Err.Number
      Close #fileNumber
      Resume Next
   End Function
   
   Private Sub Command2_Click()
       'Use this to view the log file.
       Shell "notepad.exe c:\ChangeTemplate.log", 1
   End Sub
   

   Em um módulo padrão, adicione o seguinte código:

   Sub ChangeTemplate(SourceFile As String, strServer As String, objWord As Object)
   
      Dim dlgTemplates As Dialog
      Dim strTemp As String
      Dim strpath As String
      Dim objtemplate As String
      Dim dlgTemplate As Object
      Dim x As Integer
      Dim fNumber As Integer
      Dim objDoc As Object
      
      fNumber = FreeFile
         
      objWord.Visible = False
      strTemp = SourceFile
   
      'This function determines if the document is password protected or Read Only.
      If OpenDocument(objWord, strTemp) = True Then
         'This assumes that there is only one document opened. It may have to be adjusted
         'to look for additional document being opened.
          Set objDoc = objWord.Documents(1)
          'Dialogs 87 is the Templates and Addins dialog
          Set dlgTemplates = objWord.Dialogs(87)
          objtemplate = objWord.Dialogs(87).Template
   
          'parse out the server name from the fullname of the attached template
   
          If Mid(objtemplate, 2, 1) = ":" Or Left(objtemplate, 2) = "\\" Then
             x = InStr(3, objtemplate, "\")
             strTemp = Mid(objtemplate, 3, x - 3)
             'if the parse name is the same as the stated server then
             'change the attached template to the Normal
   
             If strTemp = strServer Then
                objDoc.AttachedTemplate = "Normal.dot"
                'write to a log file the file name and location
                Open "C:\ChangeTemplate.log" For Append As #fNumber
                Write #fNumber, "Document: " & objDoc.fullName & _
                "Attached template changed to Normal.dot"
                Close #fNumber
             End If
          End If
               
        'After the template  is changed, the document is saved and closed.
               
         objDoc.Save
         objDoc.Close
            Else
         'Enter into the log file files that are not opened.
         Open "C:\ChangeTemplate.log" For Append As #fNumber
         Write #fNumber, "Document:  " & SourceFile & "  not opened! it's 
         Read Only or Password Protected"
         Close #fNumber
      End If
   
   End Sub
   Function OpenDocument(ByRef objWord As Object, ByVal sDoc As String) As Boolean
   'Arguments:
   ' objWord - a valid Word Application object.
   ' sDoc    - the complete path and file name of the document to open in Word.
   '
   'Opens the document specified by the sDoc variable.
   'This function returns True if the document is opened and is read/write.
   'Else, this function returns False if the document cannot be opened
   'or if the document is opened read-only because of the "read-only recommended" setting 
   'in the document.
   'Therefore only if this function returns True if you try  to modify the document.
   'If False is returned, log the sDoc into a text file and alert the user
   'of the list of file(s) that could not be processed by the batch routine.
       On Error GoTo EH
       Dim oDoc As Object
       Set oDoc = objWord.Documents.Open( _
           FileName:=sDoc, _
           ReadOnly:=False, _
           PasswordDocument:="?#nonsense@$", _
           WritePasswordDocument:="?#nonsense@$")
       If oDoc.ReadOnly = True Then
           OpenDocument = False
       Else
           OpenDocument = True
       End If
   CleanUp:
       On Error Resume Next
       Set oDoc = Nothing
       Exit Function
   
   EH:
       'There was an error opening the file. Return False
       OpenDocument = False
       Resume CleanUp
   End Function
   

Método 3: Criar um Microsoft macro do Visual Basic for Applications (VBA) que faz um loop por todos os documentos em uma pasta e altera o nome antigo do servidor com o novo nome de servidor

Sub Test()
   Dim strFilePath As String 
   Dim strPath As String
   Dim intCounter As Integer
   Dim strFileName As String
   Dim OldServer As String
   Dim NewServer As String
   Dim objDoc As Document
   Dim objTemplate As Template
   Dim dlgTemplate As Dialog  

   OldServer = "<\\rsnj01\vol1>" 
   NewServer = "<\\rsnyc1p\vol3>" 
   strFilePath = InputBox("What is the folder location that you want to use?") 
   If Right(strFilePath, 1) <> "\" Then strFilePath = strFilePath & "\" 
   strFileName = Dir(strFilePath & "*.doc")  
      Do While strFileName <> ""    
         Set objDoc = Documents.Open(strFilePath & strFileName)    
         Set objTemplate = objDoc.AttachedTemplate    
         Set dlgTemplate = Dialogs(wdDialogToolsTemplates)    
         strPath = dlgTemplate.Template    
         If LCase(Left(strPath, 13)) = LCase(OldServer) Then        
            objDoc.AttachedTemplate = NewServer & Mid(strPath, 14)    
        End If    
         strFileName = Dir()    
         objDoc.Save                  
         objDoc.Close
      Loop  
   Set objDoc = Nothing
   Set objTemplate = Nothing
   Set dlgTemplate = Nothing  

End Sub

Método 4: Criar uma macro VBA que faz um loop por todos os documentos em uma pasta e altere o nome do servidor antigo com o modelo global (normal.dot)

Sub Test()

 

    Dim strFilePath As String

    Dim strPath As String

    Dim intCounter As Integer

    Dim strFileName As String

    Dim OldServer As String

    Dim objDoc As Document

    Dim objTemplate As Template

    Dim dlgTemplate As Dialog

    Dim nServer As Integer

 

    'hardcode the name of the old server.

 

    OldServer = "{enter the name of the Old Server}"

    nServer = Len(OldServer)

    strFilePath = InputBox("What is the folder location that you want to use?")

 

    If Right(strFilePath, 1) <> "\" Then strFilePath = strFilePath & "\"

     strFileName = Dir(strFilePath & "*.doc")

     Do While strFileName <> ""

     Set objDoc = Documents.Open(strFilePath & strFileName)

     Set objTemplate = objDoc.AttachedTemplate

     Set dlgTemplate = Dialogs(wdDialogToolsTemplates)

     strPath = dlgTemplate.Template

    

     If LCase(Left(strPath, nServer)) = LCase(OldServer) Then

     objDoc.AttachedTemplate = NormalTemplate

    End If

 

    strFileName = Dir()

    objDoc.Save

    objDoc.Close

    Loop

 

    Set objDoc = Nothing

    Set objTemplate = Nothing

    Set dlgTemplate = Nothing

 

End Sub

Método 5: Renomear o servidor, o compartilhamento ou a pasta para o nome original

Voltar para o início | Submeter comentários