extract office file's title into excel

extract office file's title into excel

• Jorge L. Perez

  Hi

  If you just want a list try the following (no defensive code this time) ..

  Regards

  Peter Mo.

  '-----------------------------------------------

  Option Explicit

  Sub main()

  Dim xla As Excel.Application ' Excel App
  Dim wb As Excel.Workbook ' general workbook

  Dim wsList As Excel.Worksheet ' worksheet for the list
  Dim rowList As Long ' last row on the list

  Dim wda As Word.Application ' Word App
  Dim wd As Word.Document ' general document

  Dim fso As FileSystemObject
  Dim fldr As Folder ' our folder
  Dim fil As File ' general file

  ' folder where files are located

  Const strFldr As String = " ... path for folder ... "

  ' headings and properties

  Const strName As String = "Name"
  Const strTitle As String = "Title"
  Const strProp As String = "QMS-DOCUMENT-NO"

  ' remember Excel

  Set xla = Excel.Application

  ' create the workbook for the list

  xla.Workbooks.Add xlWBATWorksheet
  Set wsList = ActiveSheet

  ' put in the headings

  wsList.Cells(1, 1) = strName
  wsList.Cells(1, 2) = strTitle
  wsList.Cells(1, 3) = strProp

  ' set up the row number

  rowList = 2

  ' make sure we have Word (for Word Documents)

  Set wda = Word.Application

  ' set up the Folder

  Set fso = New FileSystemObject
  Set fldr = fso.GetFolder(strFldr)

  ' work through all of the files

  For Each fil In fldr.Files

  ' is it a workbook

  If Right(fil.Name, 3) = "xls" Then
  xla.Workbooks.Open Filename:=fil.Path, ReadOnly:=True
  Set wb = ActiveWorkbook
  On Error Resume Next
  wsList.Cells(rowList, 3) = wb.CustomDocumentProperties(strProp).Value
  If Err.Number = 0 Then
  wsList.Cells(rowList, 1) = fil.Name
  wsList.Cells(rowList, 2) = wb.BuiltinDocumentProperties(strTitle).Value
  rowList = rowList + 1
  End If
  On Error GoTo 0
  wb.Close savechanges:=False
  

  ' is it a document

  ElseIf Right(fil.Name, 3) = "doc" Then
  wda.Documents.Open Filename:=fil.Path, ReadOnly:=True
  Set wd = ActiveDocument
  On Error Resume Next
  wsList.Cells(rowList, 3) = wd.CustomDocumentProperties(strProp).Value
  If Err.Number = 0 Then
  wsList.Cells(rowList, 1) = fil.Name
  wsList.Cells(rowList, 2) = wd.BuiltinDocumentProperties(strTitle).Value
  rowList = rowList + 1
  End If
  On Error GoTo 0
  wd.Close savechanges:=False
  End If
  
  Next fil

  MsgBox "complete, now save the result"

  End Sub
  

  
  

• OB

  Hi

  Mmmmmmmmmmm.... I got exactly the same effect. So I tried doing it manually i.e. opening a document or workbook and doing File/Properties/etc.

  It would appear that Word recalculates the number of pages when you open the document, and this can take some time. It is particularly noticeable on a large document. I tried with a 25 page one and it took 4 or 5 seconds, so I tried putting a 10 second wait in the program, but this wasn't long enough.

  I then tried a slightly different approach. I got the number of pages and then waited two seconds and if the number of pages was the same then I "guessed" this was the correct number of pages. (One second wasn't long enough on my PC). Not a very "clever" way I'm afraid. Anyone else got a better way

  Excel doesn't seem to be interested in Number of Pages and doesn't show this in Statistics.

  Regards

  Peter Mo.

  
  

• Korzy

  thanks Peter, it works like an angle!

  if you don't mind, could you let me know how come you know it I've trying to search the help in Excel VBA and internet but failed. how did you know these objects and properties

  
  

• Senthil Kumar N.H

  Hi

  In part answer to your second question here is a function to add a custom property to a document. You can always miss out the error checking if you know the parameters you will be supplying will be correct.

  For the first question ... do you want to create a workbook with three columns: Name, Title, & QMS-DOCUMENT-NO with one row for each file

  Peter Mo.

  Option Explicit
  ' Successful return value
  Public Const ERR_CUSTOM_SUCCESS As Long = 0

  ' This error is for when user specifies a data type and value that do not
  ' match. e.g., Data type = Date, Value = "True", etc.
  Public Const ERR_CUSTOM_TYPEMISMATCH As Long = vbObjectError + 101

  ' This error is for the case where LinkToContent is False AND the optional Value
  ' parameter value is not supplied.
  Public Const ERR_CUSTOM_LINKTOCONTENT_VALUE As Long = vbObjectError + 102

  ' This error is for the case where LinkToContent is True but there is no value
  ' supplied for the source of the link (LinkSource argument to
  ' DocumentProperties.Add() method).
  Public Const ERR_CUSTOM_LINKTOCONTENT_LINKSOURCE As Long = vbObjectError + 103

  ' This error is for invalid data type specifier supplied for the
  ' LinkSource Type argument to DocumentProperties.Add() method.
  Public Const ERR_CUSTOM_INVALID_DATATYPE As Long = vbObjectError + 104

  ' This error is for invalid property name supplied for the
  ' DocumentProperties.Add() method.
  Public Const ERR_CUSTOM_INVALID_PROPNAME As Long = vbObjectError + 105

  
  Function AddCustomDocumentProperty(strPropname As String, _
  lngPropType As Long, _
  Optional varPropValue As Variant = "", _
  Optional blnLinkToContent As Boolean = False, _
  Optional varLinkSource As Variant = "") _
  As Long
  
  ' This procedure adds the custom property specified in the strPropName
  ' argument. If the blnLinkToContent argument is True, the custom
  ' property is linked to the location specified by varLinkSource.
  ' The procedure first checks for missing or inconsistent input parameters.
  ' For example, a value must be provided unless the property is linked, and
  ' when you are using linked properties, the source of the link must be provided.

  Dim prpDocProp As DocumentProperty
  
  ' Validate data supplied in arguments to this procedure.
  If blnLinkToContent = False And Len(varPropValue) = 0 Then
  ' No value supplied for custom property.
  AddCustomDocumentProperty = ERR_CUSTOM_LINKTOCONTENT_VALUE
  Exit Function
  ElseIf blnLinkToContent = True And Len(varLinkSource) = 0 Then
  ' No source provided for LinkToContent scenario.
  AddCustomDocumentProperty = ERR_CUSTOM_LINKTOCONTENT_LINKSOURCE
  Exit Function
  ElseIf lngPropType < msoPropertyTypeNumber Or _
  lngPropType > msoPropertyTypeFloat Then
  ' Invalid value for data type specifier. Must be one of the
  ' msoDocProperties enumerated constants.
  AddCustomDocumentProperty = ERR_CUSTOM_INVALID_DATATYPE
  Exit Function
  ElseIf Len(strPropname) = 0 Then
  ' No name supplied for new custom property.
  AddCustomDocumentProperty = ERR_CUSTOM_INVALID_PROPNAME
  Exit Function
  End If
  
  Call DeleteIfExisting(strPropname)

  Select Case blnLinkToContent
  Case True
  Set prpDocProp = ActiveWorkbook.CustomDocumentProperties _
  .Add(Name:=strPropname, LinkToContent:=blnLinkToContent, _
  Type:=lngPropType, LinkSource:=varLinkSource)
  ActiveWorkbook.Save
  Case False
  Set prpDocProp = ActiveWorkbook.CustomDocumentProperties. _
  Add(Name:=strPropname, LinkToContent:=blnLinkToContent, _
  Type:=lngPropType, Value:=varPropValue)
  End Select

  End Function

  
  Function DeleteIfExisting(strPropname As String)
  Dim prpDocProp As DocumentProperty
  
  On Error Resume Next
  
  Set prpDocProp = ActiveWorkbook.CustomDocumentProperties(strPropname)
  If Err = 0 Then
  prpDocProp.Delete
  End If
  End Function

  
  

  
  

• geetasain

  Hello Peter,

  Don't know if you are still willing to help

  I plan to use your method to extract the document's pages. but it's not working properly:

  wsList.Cells(rowList, 8).Formula = wb.BuiltinDocumentProperties(wdPropertyPages).Value

  when when i run the code, all word documents return "2" instead of the real pages number; and some excel file don't even return the number.

  What's wrong with the code

  
  

• Romiko

  Hi

  Apologies, to use these objects you need to REFERENCE them, use Microsoft Word Object Library for the Word information and Microsoft Scripting Runtime for the FileSystemObject, etc.

  Originally I got a copy of Office 2000 VBA Programmer's Guide. In fact one of the answers I gave was a straight extract from one of the samples. I still keep my copy handy in case I come across an area I'm not sure about. It's a bit out of date, but it gives me an idea where to look. I'm not sure what the current book is called.

  Regards

  Peter Mo.

  
  
• extract office file's title into excel