Excel Properties

[sheeeng]

I would like to know how can I display the followings for Excel:

1. Author
2. Last Saved By
3. Application Name
4. Company
5. Date Created
6. Data Last Saved
7. Edit Time
8. Revision Number
9. Others Relavant...



All above needed to be displayed at the new (non exist) or existing sheet named as Properties... :help

I know these data can be accessed through right click the Excel docment and select properties, but I do not want to go through a these steps.

Also, can we display in a floating form or toolbar for inserting this data into Active Cell? :doh:

Is it possible?

Thx

[Ken Puls]

Hi Sheeng,

I can give you the place to start in on this, but I can't see an easy way to get them. You'll need to do a bit of work, and some sleuthing.

If you step through the following code (don't run it, just step line by line through the procedure using the "step into" item on the debug toolbar.)


Sub test3()
Dim ws As Workbook, l As Long
Set ws = ActiveWorkbook
'Stop stepping when this next line is highlighted
l = l + 1
End Sub

Now, with that line highlighted, make sure that the Locals window is active. You should be able to expand ws, and then expand the BuiltInDocumentProperties. Within that, there should be a bunch of Item1, Item2, etc...

If you expand those, you'll see the properties and values you're after.

You'd then need to write a loop to extract the correct values.

Good luck!

[sheeeng]

Great! Never I use Locals before.
Thx for teaching me...!

But how to extract the data? I don't know...:(
Can giv me some hints?

What uses does Locals have? Any benefits? :doh:

[Ken Puls]

Hmm... sure, okay.

In my workbook, I could get info like this:


ws.range("A1").value = ws.BuiltInDocumentProperties.Item3.value

Which would return me "Ken Puls". (Author)

Or, we could loop through them like so


Dim ws As Workbook, l As Long
Set ws = ActiveWorkbook
For l = 1 To ws.BuiltinDocumentProperties.Count
ws.Range("A65536").End(xlUp).Offset(1, 0).Value = _
ws.BuiltinDocumentProperties.Item(l).Name
ws.Range("A65536").End(xlUp).Offset(0, 1).Value = _
ws.BuiltinDocumentProperties.Item(l).Value
Next l

Cheers!

[sheeeng]

OIC, I cannot do this before because I use


Application.Author

Stupid me...:banghead:

Thx :friends:

[sheeeng]

Or, we could loop through them like so


Dim ws As Workbook, l As Long
Set ws = ActiveWorkbook
For l = 1 To ws.BuiltinDocumentProperties.Count
ws.Range("A65536").End(xlUp).Offset(1, 0).Value = _
ws.BuiltinDocumentProperties.Item(l).Name 'Error
ws.Range("A65536").End(xlUp).Offset(0, 1).Value = _
ws.BuiltinDocumentProperties.Item(l).Value
Next l

Cheers!

I got error on the loops..

[Justinlabenne]

I am not really satisfied with this one, but it gets a few properties from the activeworkbook.


Option Explicit

Sub GetProps()
Dim vArr As Variant
Dim lCell As Long
vArr = Array("Title", "Subject", "Author", "Manager", "Company", _
"Category", "Keywords", "Comments", "Hyperlink Base")
On Error GoTo ErrHandle
Sheets.Add
ActiveSheet.Name = "Properties"
For lCell = 0 To 8
Cells(lCell + 1, 1) = vArr(lCell)
Cells(lCell + 1, 2) = GetProperty(CStr(vArr(lCell)))
Next lCell
Columns("A:B").AutoFit
Exit Sub
ErrHandle:
MsgBox Err.Description
End Sub


Public Function GetProperty(P As String, Optional WorkbookName As Variant)
Dim S As Variant
Dim WB As Workbook
On Error Resume Next
Set WB = ActiveWorkbook
S = WB.CustomDocumentProperties(P)
If S <> "" Then
GetProperty = S
Exit Function
End If
On Error GoTo EndMacro
GetProperty = WB.BuiltinDocumentProperties(P)
Exit Function
EndMacro:
GetProperty = ""
End Function

Function is a modified one from Chip Pearson's site (http://www.cpearson.com/excel/docprop.htm)

[sheeeng]

Good, Justin. But I prefer to continue with Puls codes..

Thx for sharing....

[Justinlabenne]

Uh... okay, but the code extracts the data you wanted, and isn't giving me any error messages in the loop.

No offense to Ken's code...

[sheeeng]

No offence of course...We are here to learn...No hard feeling here..
Thx for sharing again...

ps. Is Ohio a nice place? More hot then Malaysia?

[Ken Puls]

Oops!

Give this a shot:


Dim wb As Workbook, l As Long
Set wb = ActiveWorkbook
On Error Resume Next
For l = 1 To ws.BuiltinDocumentProperties.Count
wb.Sheets(1).Range("A65536").End(xlUp).Offset(1, 0).Value = _
wb.BuiltinDocumentProperties.Item(l).Name
wb.Sheets(1).Range("A65536").End(xlUp).Offset(0, 1).Value = _
wb.BuiltinDocumentProperties.Item(l).Value
Next l
On Error GoTo 0

(No offense taken Justin!)

[sheeeng]

Aiyo!...No error! BUT no output ... :banghead:

[Ken Puls]

Huh? :wot

Okay, one more tiny thing... I seem to have missed changing one of the ws's to wb's:



Dim wb As Workbook, l As Long
Set wb = ActiveWorkbook
On Error Resume Next
For l = 1 To wb.BuiltinDocumentProperties.Count
wb.Sheets(1).Range("A65536").End(xlUp).Offset(1, 0).Value = _
wb.BuiltinDocumentProperties.Item(l).Name
wb.Sheets(1).Range("A65536").End(xlUp).Offset(0, 1).Value = _
wb.BuiltinDocumentProperties.Item(l).Value
Next l
On Error Goto 0

Thing is, that should have kicked up an error. I just ran this in a brand new wokbook with nothing else in it, and it gave me info. You're sure it's not just on another sheet somewhere? :dunno

[sheeeng]

Huh? :wot

Okay, one more tiny thing... I seem to have missed changing one of the ws's to wb's:



Dim wb As Workbook, l As Long
Set wb = ActiveWorkbook
On Error Resume Next
For l = 1 To wb.BuiltinDocumentProperties.Count
wb.Sheets(1).Range("A65536").End(xlUp).Offset(1, 0).Value = _
wb.BuiltinDocumentProperties.Item(l).Name
wb.Sheets(1).Range("A65536").End(xlUp).Offset(0, 1).Value = _
wb.BuiltinDocumentProperties.Item(l).Value
Next l
On Error Goto 0

Thing is, that should have kicked up an error. I just ran this in a brand new wokbook with nothing else in it, and it gave me info. You're sure it's not just on another sheet somewhere? :dunno

This work ! Hooray!!! :friends: :thumb