Solved

Word-VBA-read file & write to properties

Posted on 2001-07-05
20
13,842 Views
Last Modified: 2008-03-03
Hello,

I have a project that needs to do the following once a quarter and will involve 200+ documents each time so I'm looking for a semi-portable solution.
1. Set the document properties in a standardized fashion.

Each document follows a strict template so I will be able to open the file, "scrape" the data I need, re-format it for the properties, set the new properties, save and close the file.

I propose the following using VBA code:
(simplified for brevity)
1. open the file
2. do a search in the file for a person's name (Instr, Mid, etc.) (always located in the same place)
3. re-format the name (Last, First M.) set that name into the title property
4. save file
5. close file

I'm looking for specific code and am open to a whole new proccess, this is what i've come up with so far....

cheers!
0
Comment
Question by:rdmjrb
  • 10
  • 10
20 Comments
 
LVL 2

Accepted Solution

by:
Gudare earned 100 total points
ID: 6256927
If you would clarify, are you looking for the code that would do your proposed method, or a new method?

-Craig
0
 
LVL 2

Author Comment

by:rdmjrb
ID: 6257311
Gudare/Craig:

>>am open to a whole new proccess

If you suggest an easier solution, I would be open to it, as i said, the solution I posted was my best guess.

Regards, rdmjrb
0
 
LVL 2

Expert Comment

by:Gudare
ID: 6257397
Well, the following code will get you through opening the files for usage, but without a file or specific examples of your datascrape/wanted results once you've got it open, I'll show you the part for dealing with the file itself:

Sub OpenCloseFiles()

    ' Load all files wanted to be used in macro into one folder with
    ' no other files inside that folder. Modify FILE_PATH constant
    ' to read correct path.
   
    Dim strFileName As String
    Dim docOpenedFile As Document
   
    Const FILE_PATH As String = "C:\My Documents\"
   
    strFileName = Dir(FILE_PATH)
   
    Do Until strFileName = ""
        If Not ((strFileName = ".") Or (strFileName = "..")) Then
            If Not GetAttr(FILE_PATH & strFileName) = vbDirectory Then
                docOpenedFile = Application.Documents.Open(FILE_PATH & strFileName)
                ' Perform datascrape and operations here.
                docOpenedFile.Close
            End If
        End If
        strFileName = Dir()
    Loop

End Sub

-Craig

0
 
LVL 2

Author Comment

by:rdmjrb
ID: 6257508
Craig:

The datascrape would be something like this:

Each document contains 4 pieces of information:
1. Name (First Middle/M. Last) - which I would convert to (Last, First Middle/M.)
2. Group
3. Title
4. FocusDescription

I will place the data into 2 properties:
1. Title (Name - Group - OfficeLocation - (Title))
2. Comments (FocusDescription)

Since I do not have the OfficeLocation within the document each location will have its own function with the OfficeLocation hardcoded.

Let me know if you need further information.

Regards, rdmjrb
0
 
LVL 2

Expert Comment

by:Gudare
ID: 6257552
Definately, I'd need to see a sample document, basically, so I know how to get at the data, ie: Field bookmarks, which paragraph number, so on, so forth. Right now, I'm basically blind as to where the data is within a word document. If you'd like, email me a sample at craigt.farrell@pchelps.com, and I'll be happy to review it. Also, the properties you're discussing, where do you intend to save these, into the General Properties of the entire document as custom properties or if not that, please be more specific as to your intended storage.
0
 
LVL 2

Author Comment

by:rdmjrb
ID: 6257590
Craig:

1. check your email for the document.
2. i will save them into the regular properties as said in the previous post (Title, Comments)

Regards, rdmjrb
0
 
LVL 2

Expert Comment

by:Gudare
ID: 6257740
Quick and dirty.

Option Explicit

Sub OpenCloseFiles()
On Error GoTo Err_OpenCloseFiles

   ' Load all files wanted to be used in macro into one folder with
   ' no other files inside that folder. Modify FILE_PATH constant
   ' to read correct path.
   
   Dim strFileName As String
   Dim docOpenedFile As Document
   
   Const FILE_PATH As String = "C:\My Documents\"
   
   strFileName = Dir(FILE_PATH)
   
   Do Until strFileName = ""
       If Not ((strFileName = ".") Or (strFileName = "..")) Then
           If Not GetAttr(FILE_PATH & strFileName) = vbDirectory Then
               docOpenedFile = Application.Documents.Open(FILE_PATH & strFileName)
               DataScrape docOpenedFile
               docOpenedFile.Close
           End If
       End If
       strFileName = Dir()
   Loop

Exit_OpenCloseFiles:
    On Error Resume Next
    docOpenedFile.Close
    Set docOpenedFile = Nothing
    Exit Sub

Err_OpenCloseFiles:
    Select Case Err.Number
    Case Else
        MsgBox Err.Number & ": " & Err.Description, vbCritical, "OpenCloseFiles"
        Resume Exit_OpenCloseFiles
    End Select

End Sub

Sub DataScrape(ByRef doc As Document)
   
    Dim strTitle As String
    Dim strComment As String
    Dim strTemp As String
   
    Const LOCATION As String = "Enter Location Here"
   
    ' Get Name
    ' Remove the paragraph mark at end of paragraph
    strTemp = Left(doc.Paragraphs(4).Range.Text, Len(doc.Paragraphs(4).Range.Text) - 1)
    strTitle = Right(strTemp, Len(strTemp) - InStr(InStr(strTemp, " ") + 1, strTemp, " ")) & ", " & Left(strTemp, InStr(InStr(strTemp, " ") + 1, strTemp, " ") - 1)
   
    ' Get Group
    strTemp = Left(doc.Paragraphs(8).Range.Text, Len(doc.Paragraphs(8).Range.Text) - 1)
    strTitle = strTitle & " - " & strTemp
   
    ' Get Office Location
    strTitle = strTitle & LOCATION
   
    ' Get Title
    strTemp = Left(doc.Paragraphs(5).Range.Text, Len(doc.Paragraphs(5).Range.Text) - 1)
    strTitle = strTitle & " - (" & strTemp & ")"
   
    strComment = Left(doc.Paragraphs(11).Range.Text, Len(doc.Paragraphs(11).Range.Text) - 1)

    doc.BuiltInDocumentProperties("Title") = strTitle
    doc.BuiltInDocumentProperties("Comments") = strComment

End Sub

0
 
LVL 2

Author Comment

by:rdmjrb
ID: 6259913
craig:

getting invalid use ofproperty here:
>>docOpenedFile = Application.Documents.Open(FILE_PATH & strFileName)

also, these files are within the same directory, example, all of houston in the houston dir, sanFran in sanFran, etc.

thanks, ron
0
 
LVL 2

Expert Comment

by:Gudare
ID: 6260156
My bad, line of code should read: set docOpened File = ...
0
 
LVL 2

Author Comment

by:rdmjrb
ID: 6260537
Craig:

The code is running fine now, but it only sets the Title property=<<IMAGE01>>


The rest of the Title or Comments properties are not being set.

Also I see the searches are hardcoded:
' Get Group
   strTemp = Left(doc.Paragraphs(8).Range.Text, Len(doc.Paragraphs(8).Range.Text) - 1)

And so on, but these values will continually be different as some Group names are 6 chars and others are 23.

If you show an example of how to serach for, say a colon, then begin the search at that point and stop when there is a chr(13) or chr(10), this would encompass all groups.

Example:
Group Name:
Information Technology Group chr(13) & chr(10)
<<New Line Here>>

Once I see this logic I can code for the rest of the searchs in this manner.
   
0
How your wiki can always stay up-to-date

Quip doubles as a “living” wiki and a project management tool that evolves with your organization. As you finish projects in Quip, the work remains, easily accessible to all team members, new and old.
- Increase transparency
- Onboard new hires faster
- Access from mobile/offline

 
LVL 2

Expert Comment

by:Gudare
ID: 6260563
Actually, it's hardcoded to look for the paragraph number, not the length of text, it doesn't care about the length of text, only removing the char(13) at the end, therefore you shouldn't need to search as long as they keep the same # of paragraphs. As to pulling the wrong information, this worked perfectly against the test file you sent me, so I don't know why you're seeing image1. *shrugs* Sorry, according to what you gave me, the scrape works correctly. Are you running it against the same file?  If so, what version of Word, we might be in diff versions?
0
 
LVL 2

Author Comment

by:rdmjrb
ID: 6260629
Craig:

Ok I dig. It's working fine for the test doc,but not for a realone. Check email, getting this error:

5:Invalid procedure or call.

How can I use the code in a directory that contains multiple files?
0
 
LVL 2

Expert Comment

by:Gudare
ID: 6260689
Two problems were occuring:
First, Paragraph 5, not 4, for the user's name, was failing on blank line, had to change both halves of the equation.

I was using a nested instr that needed the middle initial to exist or it would fail, not a big worry. It now contains an if statement to deal with the issue.

This code if you run: OpenCloseFiles will loop through *every* file in a folder, so it's already setup to do that, that's what the dir() is all about.

I modified this code slightly to deal with the save over message, so you should be good to go. Copy/paste this in and give it a whirl.

Option Explicit

Sub OpenCloseFiles()
On Error GoTo Err_OpenCloseFiles

  ' Load all files wanted to be used in macro into one folder with
  ' no other files inside that folder. Modify FILE_PATH constant
  ' to read correct path.
 
  Dim strFileName As String
  Dim docOpenedFile As Document
 
  Const FILE_PATH As String = "C:\data\client\rdm\"
 
  strFileName = Dir(FILE_PATH)
 
  Do Until strFileName = ""
      If Not ((strFileName = ".") Or (strFileName = "..")) Then
          If Not GetAttr(FILE_PATH & strFileName) = vbDirectory Then
              Set docOpenedFile = Application.Documents.Open(FILE_PATH & strFileName)
              DataScrape docOpenedFile
              docOpenedFile.Save
              docOpenedFile.Close
          End If
      End If
      strFileName = Dir()
  Loop

Exit_OpenCloseFiles:
   On Error Resume Next
   docOpenedFile.Close
   Set docOpenedFile = Nothing
   Exit Sub

Err_OpenCloseFiles:
   Select Case Err.Number
   Case Else
       MsgBox Err.Number & ": " & Err.Description, vbCritical, "OpenCloseFiles"
       Resume Exit_OpenCloseFiles
   End Select

End Sub

Sub DataScrape(ByRef doc As Document)
   
   Dim strTitle As String
   Dim strComment As String
   Dim strTemp As String
   Dim LastNamePosition As Integer
   
   Const LOCATION As String = "Toronto"
   
   ' Get Name
   ' Remove the paragraph mark at end of paragraph
   strTemp = Left(doc.Paragraphs(5).Range.Text, Len(doc.Paragraphs(5).Range.Text) - 1)
   LastNamePosition = InStr(strTemp, " ")
   If LastNamePosition <> 0 Then
        If InStr(LastNamePosition + 1, strTemp, " ") <> 0 Then
            LastNamePosition = InStr(LastNamePosition + 1, strTemp, " ")
        End If
    End If
   strTitle = Right(strTemp, Len(strTemp) - LastNamePosition) & ", " & Left(strTemp, LastNamePosition - 1)
   
   ' Get Group
   strTemp = Left(doc.Paragraphs(8).Range.Text, Len(doc.Paragraphs(8).Range.Text) - 1)
   strTitle = strTitle & " - " & strTemp
   
   ' Get Office Location
   strTitle = strTitle & " - " & LOCATION
   
   ' Get Title
   strTemp = Left(doc.Paragraphs(6).Range.Text, Len(doc.Paragraphs(6).Range.Text) - 1)
   strTitle = strTitle & " - (" & strTemp & ")"
   
   strComment = Left(doc.Paragraphs(11).Range.Text, Len(doc.Paragraphs(11).Range.Text) - 1)

   doc.BuiltInDocumentProperties("Title") = strTitle
   doc.BuiltInDocumentProperties("Comments") = strComment

End Sub



0
 
LVL 2

Author Comment

by:rdmjrb
ID: 6260747
Craig:

ok...its running like a champion,however I placed some files in the directory to test and they were not modified. Only 2 files were modified: original(containing the macro) and another misc one. Then I deleted the misc one and re-ran itand only the orig one was modified.

What do you think the problem is?

And do I have to open all the files before the code works?
0
 
LVL 2

Expert Comment

by:Gudare
ID: 6260779
To confirm:
The files are in the directory main, not in a subfolder of the directory.

The files are .doc files

If you step through, do the files open and close without saving changes?
0
 
LVL 2

Author Comment

by:rdmjrb
ID: 6260815
Yes
Yes

and sometimes

Here is what happens:
1. I have 3 files: 1.doc, 2.doc, 3.doc
2. The macro is in 1.doc
3. I run the macro successfully
4. Changes occur in all files
5. Add 3 more files:4.doc and so on
6. Run the macro from 1.doc and changes do not occur
7. Add the macro to 4.doc and run
8. changes occur

Its strange...i want to have one directory and one template file that contains the macro, and any file in that directory willhave changes made no matter what order and so on.

I am trying to troubleshoot it, but without much luck.
0
 
LVL 2

Author Comment

by:rdmjrb
ID: 6260820
perhaps there is a variable being left open or some liek this...
0
 
LVL 2

Expert Comment

by:Gudare
ID: 6260851
I don't know, let me think on that set of problems over the weekend. Something's gotta be triggering it but I'll be danged if I know what...
0
 
LVL 2

Author Comment

by:rdmjrb
ID: 6275729
Gudare:

The problem mentioned above is in-frequent and is minuscule compared to the precision and speed in which you delivered a the solution.

Cheers - rdmjrb
0
 
LVL 2

Expert Comment

by:Gudare
ID: 6277292
My thanks.

Unfortunately I just can't get the problem to occur locally, been trying all week, sorry for not updating you. Appreciate the acceptance of the answer, but I just can't find it.

Good luck to you. :)

-Craig
0

Featured Post

Why You Should Analyze Threat Actor TTPs

After years of analyzing threat actor behavior, it’s become clear that at any given time there are specific tactics, techniques, and procedures (TTPs) that are particularly prevalent. By analyzing and understanding these TTPs, you can dramatically enhance your security program.

Join & Write a Comment

Entering a date in Microsoft Access can be tricky. A typo can cause month and day to be shuffled, entering the day only causes an error, as does entering, say, day 31 in June. This article shows how an inputmask supported by code can help the user a…
Using Word 2013, I was experiencing some incredible lag when typing.  Here's what worked for me....
This video shows the viewer how to set up and create Footnotes in their document. Click on the References tab: Select "Insert Footnote": Type in desired text:
This video walks the viewer through the process of creating envelopes and labels, with multiple names and addresses. Navigate to the “Start Mail Merge” button in the Mailings tab: Follow the step-by-step process until asked to find the address doc…

708 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

16 Experts available now in Live!

Get 1:1 Help Now