Solved

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

Posted on 2008-10-14
6
1,517 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
  • 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
Is Your Active Directory as Secure as You Think?

More than 75% of all records are compromised because of the loss or theft of a privileged credential. Experts have been exploring Active Directory infrastructure to identify key threats and establish best practices for keeping data safe. Attend this month’s webinar to learn more.

 
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

Is Your Active Directory as Secure as You Think?

More than 75% of all records are compromised because of the loss or theft of a privileged credential. Experts have been exploring Active Directory infrastructure to identify key threats and establish best practices for keeping data safe. Attend this month’s webinar to learn more.

Question has a verified solution.

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

Suggested Solutions

Title # Comments Views Activity
Remove Office macro by VC++ 10 89
Numerous files can not be opened anymore 17 63
Help with Word VBA class module 4 37
MS Word document > cursor placement 5 24
When creating Microsoft Word-based forms there may be a need to have a form field repeated throughout the whole document. For instance, with a company name, you may want this information repeated automatically throughout the document rather than man…
I would like to show you some basics you can do with Mailings in MS Word. It´s quite handy feature you can use for creating envelopes, labels, personalized letters etc. First question could be what is this feature good for? Mailing can really he…
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.
In a previous video Micro Tutorial here at Experts Exchange (http://www.experts-exchange.com/videos/1358/How-to-get-a-free-trial-of-Office-365-with-the-Office-2016-desktop-applications.html), I explained how to get a free, one-month trial of Office …

911 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

Need Help in Real-Time?

Connect with top rated Experts

21 Experts available now in Live!

Get 1:1 Help Now