?
Solved

Exporting Word properies

Posted on 2013-11-13
11
Medium Priority
?
242 Views
Last Modified: 2013-11-14
Hello Experts,

I have a folder which hold nothing but word documents.
Each of these documents contain a varying number of pages.

I'm wondering if  there is a way to export the name of these documents along with the page counts to an excel sheet?

Alternatively, is there a script in Excel to List files in a folder and their properties?
0
Comment
Question by:PLA_LTM
[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
  • 6
  • 3
  • 2
11 Comments
 
LVL 52

Expert Comment

by:Rgonzo1971
ID: 39647591
Hi,

pls try in an excel worbook

Sub FindProperties()
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Application.EnableEvents = False

On Error Resume Next
strDirectory =  "C:\MyDocuments\"
strFile = Dir(strDirectory & "*.doc*")
Set WD = CreateObject("Word.Application")
WD.Application.Visible = False
strFile = Dir
strFile = Dir
Do While strFile <> ""
    Set WdDoc = WD.Documents.Open(strDirectory & strFile)
    ActiveSheet.Range("A" & Idx).Value = strFile
    NbPages = WdDoc.BuiltinDocumentProperties(14)
    ActiveSheet.Range("A" & Idx).Offset(, 1).Value = NbPages
    WdDoc.Close False
    Idx = Idx + 1
    strFile = Dir
Loop

On Error GoTo 0
Application.ScreenUpdating = True
Application.DisplayAlerts = True
Application.EnableEvents = True
WD.Quit
Set WD = Nothing
End Sub

Open in new window

Regards
0
 
LVL 59

Expert Comment

by:Chris Bottomley
ID: 39647748
Take the following script and paste into a new file rename as a VBScript file for example Q_28293541.vbs.

Modify the line 9 folder to point to your folder and then after saving, execute the file.

Dim arr()
Dim wdApp
Dim intCount

On Error Resume Next
intCount = 0
ReDim arr(1, intCount)
Set fso = CreateObject("Scripting.FileSystemObject")
Set folder = fso.GetFolder("C:\DeleteMe\Lantau Songbook")
Set Files = folder.Files

Set wdApp = CreateObject("Word.application")
For Each fil In Files
    Q28293541_1 fil
Next
wdApp.Quit
For elem = 0 To UBound(arr, 2)
    WScript.echo arr(0, elem) & "     " & arr(1, elem)
Next
Set xlapp = CreateObject("excel.application")
Set xlwb = xlapp.workbooks.add
Set xlws = xlwb.sheets(1)
xlws.range("a2").resize(UBound(arr, 2) + 1, 2).value = xlapp.transpose(arr)
xlws.range("a1") = "File Name"
xlws.range("b1") = "Page Count"
xlws.range("1:2").columns.autofit
xlapp.visible = True

Sub Q28293541_1(fn)

    If Right(LCase(fn), 5) = ".docx" Or Right(LCase(fn), 5) = ".docm" Or Right(LCase(fn), 4) = ".doc" Then
        If instr(fn , "\~") = 0 Then
	        ReDim Preserve arr(1, intCount)
	        intCount = intCount + 1
	        arr(0, intCount - 1) = fn.Path
	        Set doc = wdApp.Documents.Open(fn.Path)
	        arr(1, intCount - 1) = doc.Content.Information(4)
	        doc.Close False
	    End If
    End If

End Sub

Open in new window


Chris
0
 

Author Comment

by:PLA_LTM
ID: 39647895
Chris,

this is great.  this VBS works great.

I was hoping you can help tweak this a bit.
1) I see a dialog window pop up for each file with in this folder.  My ultimate target folder will have thousands of files, is there a way to suppress the dialog box?


2)is there a way i can embed this in an excel sheet, where when I open the excel workbook this macro just runs?  (sorry if this is a stupid question but I'm not very well versed in the coding world)
0
Technology Partners: We Want Your Opinion!

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!

 
LVL 59

Expert Comment

by:Chris Bottomley
ID: 39647904
I tested and got no pop ups ... do you get an inkling on what they are asking / saying?
0
 
LVL 59

Expert Comment

by:Chris Bottomley
ID: 39647912
For embedding into excel see RGonzos post ... although I have not tested I do see an error at line 16:

NbPages = WdDoc.BuiltinDocumentProperties(14)

Which should use '4'

NbPages = WdDoc.BuiltinDocumentProperties(4)

That aside it may do what you ask

Chris
0
 
LVL 59

Expert Comment

by:Chris Bottomley
ID: 39647919
A slight tweak to mine (line 13 inserted) to suppress might be:

Dim arr()
Dim wdApp
Dim intCount

On Error Resume Next
intCount = 0
ReDim arr(1, intCount)
Set fso = CreateObject("Scripting.FileSystemObject")
Set folder = fso.GetFolder("C:\DeleteMe\Lantau Songbook")
Set Files = folder.Files

Set wdApp = CreateObject("Word.application")
wdApp.visible = false
For Each fil In Files
    Q28293541_1 fil
Next
wdApp.Quit
For elem = 0 To UBound(arr, 2)
    WScript.echo arr(0, elem) & "     " & arr(1, elem)
Next
Set xlapp = CreateObject("excel.application")
Set xlwb = xlapp.workbooks.add
Set xlws = xlwb.sheets(1)
xlws.range("a2").resize(UBound(arr, 2) + 1, 2).value = xlapp.transpose(arr)
xlws.range("a1") = "File Name"
xlws.range("b1") = "Page Count"
xlws.range("1:2").columns.autofit
xlapp.visible = True

Sub Q28293541_1(fn)

    If Right(LCase(fn), 5) = ".docx" Or Right(LCase(fn), 5) = ".docm" Or Right(LCase(fn), 4) = ".doc" Then
        If instr(fn , "\~") = 0 Then
	        ReDim Preserve arr(1, intCount)
	        intCount = intCount + 1
	        arr(0, intCount - 1) = fn.Path
	        Set doc = wdApp.Documents.Open(fn.Path)
	        arr(1, intCount - 1) = doc.Content.Information(4)
	        doc.Close False
	    End If
    End If

End Sub

Open in new window


Chris
0
 
LVL 59

Accepted Solution

by:
Chris Bottomley earned 1000 total points
ID: 39647948
POrted my code to VBA that you can insert into an excel module.

Modified slightly: This flavour uses sheet one but keeps the code to add a new sheet into which to pour the data:

See the lines:

'Set xlws = ThisWorkbook.Sheets.Add
Set xlWS = ThisWorkbook.Sheets("Sheet1")


Option Explicit

Dim arr()
Dim wdApp
Dim intCount

Sub FilePAges()
Dim xlWS
Dim FSO
Dim folder
Dim files
Dim fil
Dim elem

On Error Resume Next
intCount = 0
ReDim arr(1, intCount)
Set FSO = CreateObject("Scripting.FileSystemObject")
Set folder = FSO.GetFolder("C:\DeleteMe\Lantau Songbook")
Set files = folder.files

Set wdApp = CreateObject("Word.application")
wdApp.Visible = False

For Each fil In files
    Q28293541_1 fil
Next
wdApp.Quit
'Set xlws = ThisWorkbook.Sheets.Add
Set xlWS = ThisWorkbook.Sheets("Sheet1")
xlWS.Cells.Delete
xlWS.Range("a2").Resize(UBound(arr, 2) + 1, 2).Value = Application.Transpose(arr)
xlWS.Range("a1") = "File Name"
xlWS.Range("b1") = "Page Count"
xlWS.Range("1:2").Columns.AutoFit

End Sub

Sub Q28293541_1(fn)
Dim doc

    If Right(LCase(fn), 5) = ".docx" Or Right(LCase(fn), 5) = ".docm" Or Right(LCase(fn), 4) = ".doc" Then
        If InStr(fn, "\~") = 0 Then
            ReDim Preserve arr(1, intCount)
            intCount = intCount + 1
            arr(0, intCount - 1) = fn.Path
            Set doc = wdApp.Documents.Open(fn.Path)
            arr(1, intCount - 1) = doc.Content.Information(4)
            doc.Close False
        End If
    End If

End Sub

Open in new window


Chris
0
 
LVL 52

Expert Comment

by:Rgonzo1971
ID: 39648016
Hi

@ chris_bottomley
According to documentation 4 is wdPropertyKeywords and 14 wdPropertyPages

That's why I used 14
Regards
0
 
LVL 52

Expert Comment

by:Rgonzo1971
ID: 39648069
Hi

Now using 4 with Information Property

Sub FindProperties()
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Application.EnableEvents = False

On Error Resume Next
strDirectory = "\\chca6037.eur.beluni.net\a853725$\Documents\" '  "C:\MyDocuments\"
strFile = Dir(strDirectory & "*.doc*")
Set WD = CreateObject("Word.Application")
WD.Application.Visible = False
strFile = Dir
strFile = Dir
Do While strFile <> ""
    Set WdDoc = WD.Documents.Open(strDirectory & strFile)
    ActiveSheet.Range("A" & Idx).Value = strFile
    WdDoc.Bookmarks("\EndOfDoc").Select
    NbPages = WD.Selection.Information(4)
    ActiveSheet.Range("A" & Idx).Offset(, 1).Value = NbPages
    WdDoc.Close False
    Idx = Idx + 1
    strFile = Dir
Loop

On Error GoTo 0
Application.ScreenUpdating = True
Application.DisplayAlerts = True
Application.EnableEvents = True
WD.Quit
Set WD = Nothing
End Sub

Open in new window

Regards
0
 

Author Closing Comment

by:PLA_LTM
ID: 39648263
Chris this is exactly what i needed.
Thank you so much!!
0
 
LVL 59

Expert Comment

by:Chris Bottomley
ID: 39648277
Glad it helped

Chris
0

Featured Post

Enroll in August's Course of the Month

August's CompTIA IT Fundamentals course includes 19 hours of basic computer principle modules and prepares you for the certification exam. It's free for Premium Members, Team Accounts, and Qualified Experts!

Question has a verified solution.

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

Introduction This tutorial provides instructions on how to properly format your Word document using the inbuilt tools provided. The benefits of using these tools means your documents are more accessible and easily portable to other applications an…
Using Word 2013, I was experiencing some incredible lag when typing.  Here's what worked for me....
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.
This video walks the viewer through the process of creating Hyperlinks for the web and other documents. Select the "Insert" tab: Click "Hyperlink":  Type "http://" followed by a web address to reference a website or navigate to a document to ref…
Suggested Courses

770 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