Solved

VBA Word Macro: skip write- and/or password-protected files

Posted on 2008-10-14
6
1,541 Views
Last Modified: 2010-04-21
Hi there

The following Word VBA Macro Code changes the AttachedTemplate Path of all Documents in a specified folder and its subfolders to the NormalTemplate (got the code from another EE article). Everything works fine unless a write- and/or password-protected doc comes up. Is there a possibility to skip such documents so the process does not wait at these files and expecting an action? Also when another user has opened the document, this one should be skipped.

Optional: The macro should only change documents that have a specific path pattern in the Attached Template Path (e.g. "\\servername\..."). These documents and its paths should be logged in a file (txt, log, doc, ...).

Thanks for assistance!
Chris
Sub CallChangeTemplates()
 
  ChangeTemplates "c:\temp\docs", "*.doc*"
End Sub
 
Sub ChangeTemplates(strFolder As String, strFilePattern As String)
    Dim strFileName As String
    Dim strFolders() As String
    Dim iFolderCount As Integer
    Dim i As Integer
    Dim Doc As Document
    'collect child folders
    strFileName = Dir$(strFolder & "\", vbDirectory)
    Do Until strFileName = ""
        If (GetAttr(strFolder & "\" & strFileName) And vbDirectory) = vbDirectory Then
            If Left$(strFileName, 1) <> "." Then
                ReDim Preserve strFolders(iFolderCount)
                strFolders(iFolderCount) = strFolder & "\" & strFileName
                iFolderCount = iFolderCount + 1
            End If
        End If
        strFileName = Dir$()
    Loop
   
    'process files in current folder
    strFileName = Dir$(strFolder & "\" & strFilePattern)
    Do Until strFileName = ""
            DoEvents
            Set Doc = Documents.Open(strFolder & "\" & strFileName)
                Doc.AttachedTemplate = NormalTemplate
                Doc.Close wdSaveChanges
        strFileName = Dir$()
    Loop
   
    'look through child folders
    For i = 0 To iFolderCount - 1
        ChangeTemplates strFolders(i), strFilePattern
    Next i
End Sub

Open in new window

0
Comment
Question by:chassouna
[X]
Welcome to Experts Exchange

Add your voice to the tech community where 5M+ people just like you are talking about what matters.

  • Help others & share knowledge
  • Earn cash & points
  • Learn & ask questions
  • 3
  • 3
6 Comments
 
LVL 6

Expert Comment

by:Jeews
ID: 22718293
put a "on error resume next" statement in the line 29 and you can write the name of the file which failed to open to a log and refer later.
0
 

Author Comment

by:chassouna
ID: 22718374
With the "on error resume next" option the macro continues processing the files after confirming an action for the specific file with password protect or file lock. This is better than canceling. But wat I want is that no action is required for those docs, that they are skipped without any interaction. The goal is to run the macro on a file share over night and so it should not be interrupted.
0
 
LVL 6

Accepted Solution

by:
Jeews earned 500 total points
ID: 22719173
I did the code fro, the sketch, Please check whether it serves your purpose



Public PcLogFileName As String
Public PcError As String
 
Sub CallChangeTemplates()
    Dim lcCurrentDir As String
 
 
    lcCurrentDir = "C:\Documents and Settings\URathnayake\My Documents\Expert Exchange\Skip write - Password protected"
 
    PcLogFileName = lcCurrentDir + "\" + "DocumentAccessSummery.txt"
 
 
    ChangeTemplates lcCurrentDir, "*.doc*"
  
End Sub
 
Sub ChangeTemplates(lcFilePath As String, strFilePattern As String)
    
    Dim loFileSystemObject, loDirectoryList As Object
    Dim lcLogString, lcChildDirectoryName, lcDirectoryPath, lcFileName, lcFileFullPath As String
    
 
     ' Create an object form the filesystem object
    Set loFileSystemObject = CreateObject("Scripting.FileSystemObject")
    
          
    ' Get the list of clients. Note: Folders should be named with the patner names
    Set loDirectoryList = loFileSystemObject.GetFolder(lcFilePath).SubFolders
    
    
    Set loFileList = loFileSystemObject.GetFolder(lcFilePath).Files
        
        
        ' Traverse through the files
        For Each loFile In loFileList
        
            ' Get the file name to a variable to be used below
            lcFileName = loFile.Name
            
            ' Check only for excel fiels
            If InStr(1, lcFileName, "doc") > 0 And Not InStr(1, lcFileName, "~$") = 1 Then
                
                ' Construct the full path of the document
                lcFileFullPath = lcFilePath & "\" & lcFileName
            
                 ' Check whether the file is open
                If Not IsFileOpen(lcFileFullPath) Then
                
                    ' Checks the file is password protected
                    On Error Resume Next
                   Set Doc = Application.Documents.Open(lcFileFullPath, , , , "**")
                        
                     ' File is password protected
                    If Err > 0 Then
                        Update_Log ("File: " + lcFileFullPath + " is Password protected.")
                    Else
                        Doc.AttachedTemplate = NormalTemplate
                        Doc.Close wdSaveChanges
                    End If
                    
                Else
                    
                    Update_Log ("File: " + lcFileFullPath + " is in use.")
                End If
            End If
 
        Next
    
    
 
    ' Traverse to each client folder to check get the available reports
    For Each loDirectory In loDirectoryList
    
        ' Get the Name of the processing client
        lcChildDirectoryName = loDirectory.Name
        
        ' Get the full path of the client directory
        lcDirectoryPath = loDirectory.Path
        
        ' Get the list of files under the client folder to be searched for MSR reports and procees with the updating
        Set loFileList = loFileSystemObject.GetFolder(lcDirectoryPath).Files
        
        
        ' Traverse through the files
        For Each loFile In loFileList
        
            ' Get the file name to a variable to be used below
            lcFileName = loFile.Name
            
            ' Check only for word fiels without the temporary files
            If InStr(1, lcFileName, "doc") > 0 And Not InStr(1, lcFileName, "~$") = 1 Then
                
                ' Construct the full path of the document
                lcFileFullPath = lcDirectoryPath & "\" & lcFileName
            
                ' Check whether the file is open
                If Not IsFileOpen(lcFileFullPath) Then
                    
                    ' Checks the file is password protected
                    On Error Resume Next
                    Set Doc = Application.Documents.Open(lcFileFullPath, , , , "**")
                    
                        
                    ' File is password protected
                    If Err > 0 Then
                        Update_Log ("File: " + lcFileFullPath + " is Password protected.")
                    Else
                        Doc.AttachedTemplate = NormalTemplate
                        Doc.Close wdSaveChanges
                    End If
                    
                Else
                    
                    Update_Log ("File: " + lcFileFullPath + " is in use.")
                End If
            End If
 
        Next
    Next
 
    loFileSystemObject.Delete
    loDirectoryList.Delete
 
End Sub
 
Function IsFileOpen(lcFileName As String)
 
    Dim lnFileNum As Integer, lnErrNum As Integer
 
    On Error Resume Next   ' Turn error checking off.
    lnFileNum = FreeFile()   ' Get a free file number.
    ' Attempt to open the file and lock it.
    Open lcFileName For Input Lock Read As #lnFileNum
    Close lnFileNum          ' Close the file.
    lnErrNum = Err           ' Save the error number that occurred.
    On Error GoTo 0        ' Turn error checking back on.
 
    ' Check to see which error occurred.
    Select Case lnErrNum
 
        ' No error occurred.
        ' File is NOT already open by another user.
        Case 0
         IsFileOpen = False
 
        ' Error number for "Permission Denied."
        ' File is already opened by another user.
        Case 70
            IsFileOpen = True
 
        ' Another error occurred.
        Case Else
            Error lnErrNum
    End Select
 
End Function
 
Function Update_Log(lcString As String)
    
    
    If Not IsEmpty(lcString) Then
        lcString = FormatDateTime(Date, vbLongDate) + " : " + FormatDateTime(Time, vbLongTime) + " : " + lcString
        
        cfilename = FreeFile()
      
        
        On Error Resume Next
        Open PcLogFileName For Append As cfilename
        
        
        Print #cfilename, lcString
        Close #cfilename
        
        Err
    End If
 
End Function

Open in new window

0
Free Tool: ZipGrep

ZipGrep is a utility that can list and search zip (.war, .ear, .jar, etc) archives for text patterns, without the need to extract the archive's contents.

One of a set of tools we're offering as a way to say thank you for being a part of the community.

 
LVL 6

Expert Comment

by:Jeews
ID: 22719186
Please initialize lcCurrentDir variable with the path you want ie: according to the code you pasted this should be "c:\temp\docs"

Sorry for the inconvenience

0
 

Author Closing Comment

by:chassouna
ID: 31506198
Awesome! That's what I was looking for... Thank you so much!
0
 

Author Comment

by:chassouna
ID: 22719954
Awesome! That's what I was looking for... Thank you so much!
0

Featured Post

Free Tool: Subnet Calculator

The subnet calculator helps you design networks by taking an IP address and network mask and returning information such as network, broadcast address, and host range.

One of a set of tools we're offering as a way of saying thank you for being a part of the community.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

Do you ever need to create a 20 page Word document for some testing purpose? Are you tired of copying & pasting old boring "lorem ipsum" text over and over again, increasing font size and line space in order to make the document 20+ pages long? Look…
Ever visit a website where you spotted a really cool looking Font, yet couldn't figure out which font family it belonged to, or how to get a copy of it for your own use? This article explains the process of doing exactly that, as well as showing how…
This video walks the viewer through the process of creating a watermark for their document, customizing it, and saving it for viewing/printing needs.
The viewer will learn how to make their project stand out over others by learning how to change colors and shapes, add spaces, change directions, and add bullets to their charts.

691 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question