PDA

View Full Version : Help! Changing Word97 doc properties in bulk



badflyer
08-10-2006, 06:15 AM
Hey Guys! i'm after some help or advice that will allow me to change multiple word97 document fields in Properties (i.e Title, subject, Author) in a batch. I have about 100 documents to change in one go, they all share the same author and subject! Whats the easiest way to do it.. Is it possible to do it in an external VBA program?
Cheers !

lucas
08-10-2006, 06:45 AM
Good morning,
I didn't find anything on word specifically but this link is to a knowledgbase item that does what your asking in excel. You can probably change a few things in it and get it to work in word....post back if you run into snags:
http://vbaexpress.com/kb/getarticle.php?kb_id=730

badflyer
08-10-2006, 08:45 AM
Hey Steve (Lucas)! thanks for the reply there... now im a total beginner here, but the code looks exactly what i want apart from the fact it was written for excel. I changed subtle things, like filenane = *.doc and FileType = msoFileTypeWordDocuments, but the word compiler always bums out on Dim wkb As Workbook, but i would expect that, coz this is for excel...

Can you fix this for me so it works with word?

Cheers!

lucas
08-10-2006, 09:07 AM
This seems to work but I didn't spend a lot of time on it. Also see the attached file....you can run the macro with the menu next to help on the main menu(top of page)

Option Explicit
Sub ChangeLotsOfFilesProperties()
' Attributes we will be changing
' Author, Title, Comments
Const szAuthor As String = "vbaexpress.com"
Const szTitle As String = "Updated Title"
Const szComments As String = "Batch update code"


Dim szFolderPath As String
Dim objFolder As Object
Dim szbkName As String
Dim lUbk As Long
Dim i As Long
Dim wdoc As Document
Dim fso As Object
Dim f As Object


' Browse for the folder to search for project workbooks
' ===========================================================================
Set objFolder = CreateObject("Shell.Application"). _
BrowseForFolder(0, _
"Select the folder containing workbooks to update", _
0, Empty)

On Error GoTo ErrExit
If Not objFolder Is Nothing Then
szFolderPath = objFolder.items.Item.Path

Else

Exit Sub

End If
' ===========================================================================
With Application
.ScreenUpdating = False
' .EnableEvents = False
If Val(.Version) >= 9 Then 'ShowWindowsInTaskbar is for versions 2000+
.ShowWindowsInTaskbar = False
End If
End With


With Application.FileSearch
.NewSearch
.LookIn = szFolderPath
.SearchSubFolders = False
.FileName = "*.doc"
.MatchTextExactly = True
.FileType = msoFileTypeWordDocuments
.Execute

' if we found some files to update
If .FoundFiles.Count > 0 Then


' Loop through them, changing document properties
For i = 1 To .FoundFiles.Count


Set wdoc = Documents.Open(.FoundFiles(i))

' Procedure can be lengthy, status bar for updating
Application.StatusBar = "[" & i & " of " & _
.FoundFiles.Count & "] Changing properties for " & wdoc.Name


' Late binding reference to the FileSystemObject
Set fso = CreateObject("Scripting.FileSystemObject")
Set f = fso.GetFile(ActiveDocument.FullName)


' If the file is Read-Only, don't update it
If f.Attributes And 1 Then

' so close it:
wdoc.Close False

Else

' Otherwise change the specific document properties
With wdoc


' Props we are changing, Author, Title, Comments
.BuiltInDocumentProperties("Author") = szAuthor
.BuiltInDocumentProperties("Title") = szTitle
.BuiltInDocumentProperties("Comments") = szComments

' Store the workbook names we update in a variable
' This will be used to deliver our final message
szbkName = szbkName & vbNewLine & wdoc.Name


' Then save and close
.Save
.Close


End With

End If

Next i

Else

MsgBox "No files found to update", 64

End If

End With


ErrExit:
' Explicitly clear memory
Set wdoc = Nothing
Set fso = Nothing
Set f = Nothing
Set objFolder = Nothing

With Application
.ScreenUpdating = True
' .EnableEvents = True
If Val(.Version) >= 9 Then 'ShowWindowsInTaskbar is for versions 2000+
.ShowWindowsInTaskbar = True
End If
.StatusBar = Empty
End With

MsgBox "* Properties have been changed for these Files: *" & szbkName, 64
End Sub

lucas
08-10-2006, 09:45 AM
I just noticed this is for 97.....you will probably have to comment out the ShowWindowsInTaskbar code.

I also commented out the .EnableEvents = False
but there is a word version.....search the word forum.

badflyer
08-10-2006, 10:20 AM
Hi Steve, i commented out the ShowWindowsInTaskbar = True routines, but i cant get it to work with word97. It gets as far as opening the work folder, but and then it always goes to the ErrExit routine when i single step through the code. I give up !
i'll stick with electronic design, i cant figure out software!

lucas
08-10-2006, 10:30 AM
Someone with 97 will come along. Be patient, I'm sure this can be done.

badflyer
08-11-2006, 03:53 PM
With a little patience and experimentation, and a little help from the internet and msdn, i came up with this, and it works a treat! :)


Sub BatchChangeCompanyWordProperties()
'A VBA macro to bulk change the properties of word documents within a folder


'Below, Enter within the " " the Description properties of each field

Const szTitle As String = "Johns Title" ' Enter your Title
Const szSubject As String = "Johns Subject" ' Enter your Subject
Const szCategory As String = "Johns Category" ' Enter your Category
Const szKeywords As String = "Johns Keywords" ' Enter your Keywords

'Below, Enter within the " " the Origin properties of each field

Const szAuthor As String = "John" ' Enter your Title
Const szComments As String = "Johns Comments" ' Enter your Comments
Const szCompany As String = "At Home" ' Enter your Company
Const szManager As String = "Father Christmas" ' Enter your Manager


Dim i As Long
With Application.FileSearch
.LookIn = "C:\WordTemp"
.SearchSubFolders = False
.FileType = msoFileTypeWordDocuments
If .Execute() > 0 Then
For i = 1 To .FoundFiles.Count
Documents.Open .FoundFiles(i)

'Description Properties
ActiveDocument.BuiltInDocumentProperties(wdPropertyTitle) = szTitle
ActiveDocument.BuiltInDocumentProperties(wdPropertySubject) = szSubject
ActiveDocument.BuiltInDocumentProperties(wdPropertyCategory) = szCategory
ActiveDocument.BuiltInDocumentProperties(wdPropertyKeywords) = szKeywords

'Origin Properties
ActiveDocument.BuiltInDocumentProperties(wdPropertyAuthor) = szAuthor
ActiveDocument.BuiltInDocumentProperties(wdPropertyCompany) = szCompany
ActiveDocument.BuiltInDocumentProperties(wdPropertyComments) = szComments
ActiveDocument.BuiltInDocumentProperties(wdPropertyManager) = szManager


ActiveDocument.Close wdSaveChanges
Next i
Else
MsgBox "There were no files found."
End If
End With
End Sub

lucas
08-12-2006, 07:31 AM
Glad you found a solution and thanks for posting it. Be sure to mark your thread solved

mdmackillop
08-13-2006, 04:19 AM
Hi BadFlyer,
I would put your code on a userform with TextBoxes for each of your values. This can pick up the original values for editing, rather than completing all fields. Here's a sample.

badflyer
08-14-2006, 01:47 AM
Wow thats great! i didnt even know you could do userforms in VBA!
I'm learning now...thanks !!