Java

Useful VBA scripts

Lock/Unlock Word Document (must know password)

Option Explicit'Used for word files onlySub LockUnlockWordDocument() 'SETTINGS '++++++++++++++++++++++++++++++++++++++++ Dim SourceFolderPath As String SourceFolderPath = "[Your root folder]" 'Your follder where files are stored. 'Put \ at the end Dim LockedFolderPath As String LockedFolderPath = SourceFolderPath & "\locked\" 'Your folder for locked files with \ at the end Dim UnlockedFolderPath As String UnlockedFolderPath = SourceFolderPath & "\unlocked\" 'Your folder for unlocked files with \ at the end Dim Password As String Password = "password" 'Your password '++++++++++++++++++++++++++++++++++++++++ 'If files are locked, they will be unlocked and moved to unlocked folder under your root 'If files are unlocked, they will be locked and moved to locked folder under your root Dim DocFile As Document 'Word document object Dim oFSO As Object Dim oSourceFolder As Object Dim oSourceFile As Object Set oFSO = CreateObject("Scripting.FileSystemObject") Set oSourceFolder = oFSO.GetFolder(SourceFolderPath) CreateFolders (oSourceFolder.Path) Dim unlockedCount As Integer Dim lockedCount As Integer On Error Resume Next For Each oSourceFile In oSourceFolder.Files Set DocFile = Word.Documents.Open(SourceFolderPath & oSourceFile.Name, Visible:=False) If (DocFile.ProtectionType = wdNoProtection) Then DocFile.protect Password:=Password, NoReset:=False, Type:=wdAllowOnlyReading, UseIRM:=False DocFile.Close True oFSO.MoveFile oSourceFile, LockedFolderPath lockedCount = lockedCount + 1 Else DocFile.Unprotect Password:=Password DocFile.Close True Set DocFile = Word.Documents.Open(SourceFolderPath & oSourceFile.Name, Visible:=False) DocFile.Close True Debug.Print DocFile.Name & ": " & Error Error.Clear If (DocFile.ProtectionType = wdNoProtection) Then oFSO.MoveFile oSourceFile, UnlockedFolderPath unlockedCount = unlockedCount + 1 End If End If Next oSourceFile If (Err) Then Debug.Print Err.Number Debug.Print Err.Description End If ShowReport unlockedCount, lockedCount
End Sub

'Creates two folders inside SourceFolderPath (locked and unlocked)Sub CreateFolders(oSourceFolder As String) Dim LockedFolder As Object Dim UnlockedFolder As Object Dim oFSO As Object Dim strLockedFolder As String, strUnlockedFolder As String strLockedFolder = oSourceFolder & "\locked" strUnlockedFolder = oSourceFolder & "\unlocked" Set oFSO = CreateObject("Scripting.FileSystemObject") Debug.Print ("strLockedFolder: " & strLockedFolder) Debug.Print ("strUnlockedFolder: " & strUnlockedFolder) If Not oFSO.FolderExists(strLockedFolder) Then oFSO.CreateFolder strLockedFolder Debug.Print "Folder created at path: " & strLockedFolder End If If Not oFSO.FolderExists(strUnlockedFolder) Then oFSO.CreateFolder strUnlockedFolder Debug.Print "Folder created at path: " & strUnlockedFolder End IfEnd Sub

Sub ShowReport(unlockCount As Integer, lockCount As Integer) MsgBox "Unlocked: " & unlockCount & ", Locked: " & lockCountEnd Sub

Word - delete/add comments

'Removes all commentsSub RemoveComments() ActiveDocument.DeleteAllCommentsEnd Sub

'Add coments for words surrounded by ##Sub AddComments()
Dim findObject As FindDim myRange As RangeDim myDocument As DocumentDim commentText As String

Set myDocument = Application.ActiveDocumentSet myRange = myDocument.ContentSet findObject = myRange.Find
With findObject .Text = "##*##" .MatchWildcards = True End With
Dim tagString As String
Do While findObject.Execute = True myRange.Font.ColorIndex = wdPink tagString = Replace(myRange.Text, "##", "") Debug.Print tagString commentText = "NAME=" 'your text commentText = commentText & tagString & ";" With myDocument.Comments .Add Range:=myRange, Text:=commentText End WithLoop ChangeAllAuthorNamesInCommentsEnd Sub

Sub ChangeAllAuthorNamesInComments() Dim objComment As Comment
' Change all author names in comments For Each objComment In ActiveDocument.Comments objComment.Author = Application.UserName & " VBA" Next objCommentEnd Sub