Hallo Wissende,
auf http://www.xlam.ch/xlimits/downloads.htm ,
(dort mit Strg+F nach „DSOFile.exe“ suchen)
kann man sich die DSOFile.exe herunterladen.
Nach Starten der Exe hat man eine DSOFile.dll und in einem Unterverzeichnis VB-Dateien (frm,frx,log,vbp,vbw).
Laut Beschreibung auf der o.g. Webseite kann man mittels dieser dll auf die Dokumenteigenschaften von Office-Dateien(xls,doc) zugreifen.
Und dies mit VB und VBA. Als Beispiel wie das geht sind die VB-Dateien gedacht.
Ich habe VB5.0 installiert. Dort habe ich unter projekt–Verweise einen Verweis auf die dll gesetzt. Dann versucht die vbp zu öffnen.
Leider kommt sofort die im Betreff genannte Fehlermeldung samt dem Hinweis daß die vbp deshalb nicht geladen werden konnte:frowning:
Da die Tatsache daß ich VB5.0 installiert keinesfalls bedeutet daß ich auch nur irgendwas in VB weiß, so weiß ich jetzt nicht weiter 
)
Wie in **/t/frage-zu-customdocumentproperties/4648096/4
Da der Codeentwickler netterweise sprechende Präfixe für die Variablennamen benutzt hat habe ich ein vages Bild wie denn die Form bestückt ist und habe versucht dies in einer Vba-Userform nachzustellen.
D.h. aus den Codezeilen:
txtCustName.Text = „“
txtCustValue.Text = „“
lstCustType.ListIndex = 0
schloß ich daß ich dafür 2 Textboxen und eine ListBox brauche usw.
Das klappte leidlich gut, allerdings bin ich mir bei den Namen „imgIcon“ und „picPreview“ nicht ganz sicher ob es beides Bilder sind oder vielleicht doch unterschiedliche Steuerelemente.
Nachstehend ist der von mir umgesetzte Vba-Code.
Naja, ist noch eine Riesenbaustelle, die meisten Felder der Userform bleiben noch leer.
Immerhin sieht man in der ComboBox schon die Dokumenteigenschaften
Jetzt bräuchte ich halt eine funktionierende VB-Exe oder viel besser Hinweise wie ich den VB-Code zum Laufen bringe, damit ich überhaupt mal sehe wie die Form eigentlich aussieht um das nachzustellen.
Danke ^ Gruß
Reinhard
Option Explicit
'\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*
' FileProp Form Member Variables
'\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*
Private oFilePropReader As DSOleFile.PropertyReader
Private oDocProp As DSOleFile.DocumentProperties
Private Sub UserForm\_Initialize()
' Create an instance of the reader class (if this errors,
' the DLL was not registered with REGSVR32.EXE)...
Set oFilePropReader = New DSOleFile.PropertyReader
' If you plan to be working with localized documents (non-English)
' you can set this property to make sure new property sets are
' created in Unicode instead of ANSI.
'
' oFilePropReader.UseUnicodePropSets = True
'
' Office documents made with US/UK English versions of Office save
' string values in ANSI, and have had reported problems reading values
' that weren't, so for compatiblity the reader defaults to ANSI.
' Pick a file and open the properties for it, If user cancels, we exit...
If Not OpenDocumentProperties Then End
End Sub
Private Sub UserForm\_Terminate()
' Save any changes before we unload...
UpdateSummaryInfo
Set oDocProp = Nothing
Set oFilePropReader = Nothing
End Sub
Private Sub CommandButton1\_Click()
UpdateSummaryInfo
OpenDocumentProperties
End Sub
Private Sub cmdOpenFile\_Click()
UpdateSummaryInfo
OpenDocumentProperties
End Sub
Private Sub checkbox1\_Click()
' The preview is loaded in a picture box. When this item is
' checked, move the picture box on screen. Otherwise, move off..
If CheckBox1.Value Then
ListBox1.Left = -20000
Image2.Left = 1140
Else
Image2.Left = -20000
ListBox1.Left = 1140
End If
End Sub
'\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*
' OpenDocumentProperties -- Fills the dialog with properties
' from a user supplied Office document.
'\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*
Public Function OpenDocumentProperties() As Boolean
Dim oCustProp As DSOleFile.CustomProperty
Dim sFile As String, sTmp As String
GetFileFromUser:
'On error GoTo Err\_Trap
' Ask the user for an OLE Structure Storage file to read
' the document properties from...
With CommonDialog1
.Flags = cdlOFNHideReadOnly Or cdlOFNFileMustExist
.Filter = "Office Files|\*.doc;\*.xls;\*.ppt|All Files|\*.\*"
.Filename = ""
.ShowOpen
sFile = .Filename
End With
' If the user cancels the dialog, exit out.
If Len(sFile) = 0 Then Exit Function
' Here is where we load the document properties for the file
' selected. The function will return a DocumentProperties object.
' We must have exclusive access to the storage of the file. If
' another app has the file open, this function will raise an error
Set oDocProp = oFilePropReader.GetDocumentProperties(sFile)
'On error Resume Next
' Read in some of the most common properties...
'lbName.Caption = oDocProp.Name
'lbAppName.Caption = oDocProp.AppName
Label1.Caption = oDocProp.Name
Label2.Caption = oDocProp.AppName
' This gets the associated icon picture for the file type...
'Set imgIcon.Picture = oDocProp.Icon
Set Image1.Picture = oDocProp.Icon
' The standard document properties are loaded into text boxes,
' and can be changed in this sample. Other properties can be changed
' as well, but these are the only ones we demonstrate here...
TextBox3.Text = oDocProp.Title
TextBox1.Text = oDocProp.Author
TextBox2.Text = oDocProp.Comments
' Fill in the Summary/Statistics information in the Normal
' properties list. These properties are standard Summay and Document
' Properties in OLE...
ListBox1.Clear
ListBox1.AddItem "Subject: " & oDocProp.Subject
ListBox1.AddItem "Category: " & oDocProp.Category
ListBox1.AddItem "Company: " & oDocProp.Company
ListBox1.AddItem "Manager: " & oDocProp.Manager
ListBox1.AddItem "CLSID: " & oDocProp.CLSID
ListBox1.AddItem "ProgID: " & oDocProp.ProgId
ListBox1.AddItem "Word Count: " & oDocProp.WordCount
ListBox1.AddItem "Page Count: " & oDocProp.PageCount
ListBox1.AddItem "Paragraph Count: " & oDocProp.ParagraphCount
ListBox1.AddItem "Line Count: " & oDocProp.LineCount
ListBox1.AddItem "Character Count: " & oDocProp.CharacterCount
ListBox1.AddItem "Character Count (w/spaces): " & oDocProp.CharacterCountWithSpaces
ListBox1.AddItem "Byte Count: " & oDocProp.ByteCount
ListBox1.AddItem "Slide Count: " & oDocProp.SlideCount
ListBox1.AddItem "Note Count: " & oDocProp.PresentationNotes
ListBox1.AddItem "Hidden Slides: " & oDocProp.HiddenSlides
ListBox1.AddItem "MultimediaClips: " & oDocProp.MultimediaClips
ListBox1.AddItem "Last Edited by: " & oDocProp.LastEditedBy
ListBox1.AddItem "Date Created: " & oDocProp.DateCreated
ListBox1.AddItem "Date Last Printed: " & oDocProp.DateLastPrinted
ListBox1.AddItem "Date Last Saved: " & oDocProp.DateLastSaved
ListBox1.AddItem "Total Editing Time (mins): " & oDocProp.TotalEditTime
ListBox1.AddItem "Version: " & oDocProp.Version
ListBox1.AddItem "Revision Number: " & oDocProp.RevisionNumber
ListBox1.AddItem "Template Name: " & oDocProp.Template
ListBox1.AddItem "Presentation Format: " & oDocProp.PresentationFormat
On Error Resume Next
' The HasMacros property only works for Excel & Word files
' and raises error if document is not one of these. Ignore
' any error for this sample.
Dim sItem As String
sItem = CStr(oDocProp.HasMacros)
If Err Then sItem = ""
ListBox1.AddItem "Macros Attached: " & sItem
' We'll get the thumnail image of the document (if available)...
Dim oPicDisp As StdPicture
Set oPicDisp = oDocProp.Thumbnail
If oPicDisp Is Nothing Then
CheckBox1.Enabled = False
Else
Set Image2.Picture = oPicDisp
CheckBox1.Enabled = True
End If
''On error GoTo Err\_Trap
TextBox6.Text = ""
TextBox7.Text = ""
ListBox2.ListIndex = 0
' Loop through the custom properties collection and
' add each item to a list box...
ListBox3.Clear
For Each oCustProp In oDocProp.CustomProperties
sTmp = oCustProp.Name & ": " & CStr(oCustProp.Value)
sTmp = sTmp & " [" & CustTypeName(oCustProp.Type) & "]"
ListBox3.AddItem sTmp
Next
' Disable items if file is read only...
Call EnableItems((Not oDocProp.IsReadOnly))
' The operation was successful.
OpenDocumentProperties = True
Exit Function
Err\_Trap:
' Trap comm'On errors returned from componenet...
Select Case Err.Number
Case &H80040203
' The file is open by another program
MsgBox Err.Description & " Please choose another file."
Err.Clear: Resume GetFileFromUser
Case &H80040202
' The file selected is not an OLE structured storage file
MsgBox Err.Description & " Please choose another file."
Err.Clear: Resume GetFileFromUser
Case &H80040201
' DCOM is not installed -- fall through to MsgBox below
End Select
MsgBox "Error: " & Err.Description, vbCritical, "Err: " & CStr(Err.Number)
End Function
'
'Private Sub UpdateSummaryInfo()
' ' Quick and dirty save routine...
' 'On error Resume Next
' If textbox1.Text oDocProp.Author Then
' oDocProp.Author = textbox1.Text
' End If
' If textbox2.Text oDocProp.Comments Then
' oDocProp.Comments = textbox2.Text
' End If
' If textbox3.Text oDocProp.Title Then
' oDocProp.Title = textbox3.Text
' End If
'End Sub
Private Sub UpdateSummaryInfo()
' Quick and dirty save routine...
'On Error Resume Next
If TextBox1.Text oDocProp.Author Then
oDocProp.Author = TextBox1.Text
End If
If TextBox2.Text oDocProp.Comments Then
oDocProp.Comments = TextBox2.Text
End If
If TextBox3.Text oDocProp.Title Then
oDocProp.Title = TextBox3.Text
End If
End Sub
'\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*
' Add & Remove custom properties to the open file.
'\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*
Private Sub commandbutton2\_Click()
Dim sName As String, sTmp As String
Dim sValueText As String
Dim vValue As Variant
Dim lType As Long
'On error Resume Next
sName = TextBox6.Text
sValueText = TextBox7.Text
' We can't add a custom property unless we have a
' valid name and value.
If ((sName = "") Or (sValueText = "")) Then Exit Sub
' Convert the Text string to a VARIANT of the type
' specified in the drop down list.
lType = ListBox2.ListIndex + 1
Select Case lType
Case 2
vValue = CLng(sValueText)
Case 3
vValue = CDbl(sValueText)
Case 4
vValue = CBool(sValueText)
Case 5
vValue = CDate(sValueText)
Case Else
vValue = sValueText
End Select
' Add the property...
oDocProp.CustomProperties.Add sName, vValue
If Err Then
' If an error occurs, it's most likely because the
' the property name already exists...
MsgBox "The item could not be added:" & vbCrLf & Err.Description
Err.Clear
Else
' Add item to our list box...
sTmp = sName & ": " & CStr(vValue) & " ["
sTmp = sTmp & CustTypeName(lType) & "]"
ListBox3.AddItem sTmp
TextBox6.Text = ""
TextBox7.Text = ""
End If
End Sub
Private Sub cmdCustRemove\_Click()
Dim oRmProp As DSOleFile.CustomProperty
Dim sName As String, sTmp As String
'On error Resume Next
sTmp = ListBox3.List(ListBox3.ListIndex)
sName = Left(sTmp, InStr(sTmp, ":") - 1)
' Set a reference to the custom property we want and
' then call remove...
Set oRmProp = oDocProp.CustomProperties.Item(sName)
oRmProp.Remove
Set oRmProp = Nothing
ListBox3.RemoveItem ListBox3.ListIndex
'cmdCustRemove.Enabled = False
End Sub
Private Sub listbox3\_GotFocus()
'If ListBox3.ListCount 0 Then cmdCustRemove.Enabled = True
End Sub
Private Function CustTypeName(lType As Long) As String
' This function simply maps string names to the
' VARIANT type of a custom property.
Select Case lType
Case 1
CustTypeName = "String"
Case 2
CustTypeName = "Long"
Case 3
CustTypeName = "Double"
Case 4
CustTypeName = "Boolean"
Case 5
CustTypeName = "Date"
Case Else
CustTypeName = "Unknown"
End Select
End Function
Private Sub EnableItems(bEnable As Boolean)
TextBox3.Enabled = bEnable
TextBox1.Enabled = bEnable
TextBox2.Enabled = bEnable
TextBox6.Enabled = bEnable
TextBox7.Enabled = bEnable
ListBox2.Enabled = bEnable
ListBox3.Enabled = bEnable
CommandButton2.Enabled = bEnable
End Sub
'Option Explicit
'
''\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*
'' FileProp Form Member Variables
''\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*
'Private oFilePropReader As DSOleFile.PropertyReader
'Private oDocProp As DSOleFile.DocumentProperties
'
'Private Sub Form\_Load()
'
' ' Create an instance of the reader class (if this errors,
' ' the DLL was not registered with REGSVR32.EXE)...
' Set oFilePropReader = New DSOleFile.PropertyReader
'
' ' If you plan to be working with localized documents (non-English)
' ' you can set this property to make sure new property sets are
' ' created in Unicode instead of ANSI.
' '
' ' oFilePropReader.UseUnicodePropSets = True
' '
' ' Office documents made with US/UK English versions of Office save
' ' string values in ANSI, and have had reported problems reading values
' ' that weren't, so for compatiblity the reader defaults to ANSI.
'
' ' Pick a file and open the properties for it, If user cancels, we exit...
' If Not OpenDocumentProperties Then End
'
'End Sub
'
'Private Sub Form\_Unload(Cancel As Integer)
' ' Save any changes before we unload...
' UpdateSummaryInfo
' Set oDocProp = Nothing
' Set oFilePropReader = Nothing
'End Sub
'Private Sub CommandButton1\_Click()
' UpdateSummaryInfo
' OpenDocumentProperties
'
'End Sub
'
'Private Sub cmdOpenFile\_Click()
' UpdateSummaryInfo
' OpenDocumentProperties
'End Sub
'
'Private Sub checkbox1\_Click()
' ' The preview is loaded in a picture box. When this item is
' ' checked, move the picture box on screen. Otherwise, move off..
' If CheckBox1.Value Then
' ListBox1.Left = -20000
' Image2.Left = 1140
' Else
' Image2.Left = -20000
' ListBox1.Left = 1140
' End If
'End Sub
'
''\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*
'' OpenDocumentProperties -- Fills the dialog with properties
'' from a user supplied Office document.
''\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*
'Public Function OpenDocumentProperties() As Boolean
' Dim oCustProp As DSOleFile.CustomProperty
' Dim sFile As String, sTmp As String
'
'GetFileFromUser:
' 'On error GoTo Err\_Trap
'
' ' Ask the user for an OLE Structure Storage file to read
' ' the document properties from...
' With CommonDialog1
' .Flags = cdlOFNHideReadOnly Or cdlOFNFileMustExist
' .Filter = "Office Files|\*.doc;\*.xls;\*.ppt|All Files|\*.\*"
' .Filename = ""
' .ShowOpen
' sFile = .Filename
' End With
' ' If the user cancels the dialog, exit out.
' If Len(sFile) = 0 Then Exit Function
'
' ' Here is where we load the document properties for the file
' ' selected. The function will return a DocumentProperties object.
' ' We must have exclusive access to the storage of the file. If
' ' another app has the file open, this function will raise an error
' Set oDocProp = oFilePropReader.GetDocumentProperties(sFile)
'
' 'On error Resume Next
' ' Read in some of the most common properties...
' 'lbName.Caption = oDocProp.Name
' 'lbAppName.Caption = oDocProp.AppName
' Label1.Caption = oDocProp.Name
' Label2.Caption = oDocProp.AppName
'
' ' This gets the associated icon picture for the file type...
' 'Set imgIcon.Picture = oDocProp.Icon
' Set Image1.Picture = oDocProp.Icon
' ' The standard document properties are loaded into text boxes,
' ' and can be changed in this sample. Other properties can be changed
' ' as well, but these are the only ones we demonstrate here...
' TextBox3.Text = oDocProp.Title
' TextBox1.Text = oDocProp.Author
' TextBox2.Text = oDocProp.Comments
'
' ' Fill in the Summary/Statistics information in the Normal
' ' properties list. These properties are standard Summay and Document
' ' Properties in OLE...
' ListBox1.Clear
' ListBox1.AddItem "Subject: " & oDocProp.Subject
' ListBox1.AddItem "Category: " & oDocProp.Category
' ListBox1.AddItem "Company: " & oDocProp.Company
' ListBox1.AddItem "Manager: " & oDocProp.Manager
' ListBox1.AddItem "CLSID: " & oDocProp.CLSID
' ListBox1.AddItem "ProgID: " & oDocProp.ProgId
' ListBox1.AddItem "Word Count: " & oDocProp.WordCount
' ListBox1.AddItem "Page Count: " & oDocProp.PageCount
' ListBox1.AddItem "Paragraph Count: " & oDocProp.ParagraphCount
' ListBox1.AddItem "Line Count: " & oDocProp.LineCount
' ListBox1.AddItem "Character Count: " & oDocProp.CharacterCount
' ListBox1.AddItem "Character Count (w/spaces): " & oDocProp.CharacterCountWithSpaces
' ListBox1.AddItem "Byte Count: " & oDocProp.ByteCount
' ListBox1.AddItem "Slide Count: " & oDocProp.SlideCount
' ListBox1.AddItem "Note Count: " & oDocProp.PresentationNotes
' ListBox1.AddItem "Hidden Slides: " & oDocProp.HiddenSlides
' ListBox1.AddItem "MultimediaClips: " & oDocProp.MultimediaClips
' ListBox1.AddItem "Last Edited by: " & oDocProp.LastEditedBy
' ListBox1.AddItem "Date Created: " & oDocProp.DateCreated
' ListBox1.AddItem "Date Last Printed: " & oDocProp.DateLastPrinted
' ListBox1.AddItem "Date Last Saved: " & oDocProp.DateLastSaved
' ListBox1.AddItem "Total Editing Time (mins): " & oDocProp.TotalEditTime
' ListBox1.AddItem "Version: " & oDocProp.Version
' ListBox1.AddItem "Revision Number: " & oDocProp.RevisionNumber
' ListBox1.AddItem "Template Name: " & oDocProp.Template
' ListBox1.AddItem "Presentation Format: " & oDocProp.PresentationFormat
'
' 'On error Resume Next
' ' The HasMacros property only works for Excel & Word files
' ' and raises error if document is not one of these. Ignore
' ' any error for this sample.
' Dim sItem As String
' sItem = CStr(oDocProp.HasMacros)
' If Err Then sItem = ""
' ListBox1.AddItem "Macros Attached: " & sItem
'
'' We'll get the thumnail image of the document (if available)...
' Dim oPicDisp As StdPicture
' Set oPicDisp = oDocProp.Thumbnail
' If oPicDisp Is Nothing Then
' CheckBox1.Enabled = False
' Else
' Set Image2.Picture = oPicDisp
' CheckBox1.Enabled = True
' End If
'
' ''On error GoTo Err\_Trap
'
' TextBox6.Text = ""
' TextBox7.Text = ""
' ListBox2.ListIndex = 0
'
' ' Loop through the custom properties collection and
' ' add each item to a list box...
' ListBox3.Clear
' For Each oCustProp In oDocProp.CustomProperties
' sTmp = oCustProp.Name & ": " & CStr(oCustProp.Value)
' sTmp = sTmp & " [" & CustTypeName(oCustProp.Type) & "]"
' ListBox3.AddItem sTmp
' Next
'
' ' Disable items if file is read only...
' Call EnableItems((Not oDocProp.IsReadOnly))
'
' ' The operation was successful.
' OpenDocumentProperties = True
'Exit Function
'
'Err\_Trap:
' ' Trap comm'On errors returned from componenet...
' Select Case Err.Number
' Case &H80040203
' ' The file is open by another program
' MsgBox Err.Description & " Please choose another file."
' Err.Clear: Resume GetFileFromUser
' Case &H80040202
' ' The file selected is not an OLE structured storage file
' MsgBox Err.Description & " Please choose another file."
' Err.Clear: Resume GetFileFromUser
' Case &H80040201
' ' DCOM is not installed -- fall through to MsgBox below
' End Select
'
' MsgBox "Error: " & Err.Description, vbCritical, "Err: " & CStr(Err.Number)
'End Function
'
''Private Sub UpdateSummaryInfo()
'' ' Quick and dirty save routine...
'' 'On error Resume Next
'' If textbox1.Text oDocProp.Author Then
'' oDocProp.Author = textbox1.Text
'' End If
'' If textbox2.Text oDocProp.Comments Then
'' oDocProp.Comments = textbox2.Text
'' End If
'' If textbox3.Text oDocProp.Title Then
'' oDocProp.Title = textbox3.Text
'' End If
''End Sub
'Private Sub UpdateSummaryInfo()
' ' Quick and dirty save routine...
' 'On Error Resume Next
' If TextBox1.Text oDocProp.Author Then
' oDocProp.Author = TextBox1.Text
' End If
' If TextBox2.Text oDocProp.Comments Then
' oDocProp.Comments = TextBox2.Text
' End If
' If TextBox3.Text oDocProp.Title Then
' oDocProp.Title = TextBox3.Text
' End If
'End Sub
'
'
'
'
'
'
'
'
''\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*
'' Add & Remove custom properties to the open file.
''\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*
'Private Sub commandbutton2\_Click()
' Dim sName As String, sTmp As String
' Dim sValueText As String
' Dim vValue As Variant
' Dim lType As Long
'
' 'On error Resume Next
' sName = TextBox6.Text
' sValueText = TextBox7.Text
'
' ' We can't add a custom property unless we have a
' ' valid name and value.
' If ((sName = "") Or (sValueText = "")) Then Exit Sub
'
' ' Convert the Text string to a VARIANT of the type
' ' specified in the drop down list.
' lType = ListBox2.ListIndex + 1
' Select Case lType
' Case 2
' vValue = CLng(sValueText)
' Case 3
' vValue = CDbl(sValueText)
' Case 4
' vValue = CBool(sValueText)
' Case 5
' vValue = CDate(sValueText)
' Case Else
' vValue = sValueText
' End Select
'
' ' Add the property...
' oDocProp.CustomProperties.Add sName, vValue
' If Err Then
' ' If an error occurs, it's most likely because the
' ' the property name already exists...
' MsgBox "The item could not be added:" & vbCrLf & Err.Description
' Err.Clear
' Else
' ' Add item to our list box...
' sTmp = sName & ": " & CStr(vValue) & " ["
' sTmp = sTmp & CustTypeName(lType) & "]"
' ListBox3.AddItem sTmp
'
' TextBox6.Text = ""
' TextBox7.Text = ""
' End If
'
'End Sub
'
'Private Sub cmdCustRemove\_Click()
' Dim oRmProp As DSOleFile.CustomProperty
' Dim sName As String, sTmp As String
'
' 'On error Resume Next
' sTmp = ListBox3.List(ListBox3.ListIndex)
' sName = Left(sTmp, InStr(sTmp, ":") - 1)
'
' ' Set a reference to the custom property we want and
' ' then call remove...
' Set oRmProp = oDocProp.CustomProperties.Item(sName)
' oRmProp.Remove
' Set oRmProp = Nothing
'
' ListBox3.RemoveItem ListBox3.ListIndex
' cmdCustRemove.Enabled = False
'End Sub
'
'Private Sub listbox3\_GotFocus()
' If ListBox3.ListCount 0 Then cmdCustRemove.Enabled = True
'End Sub
'
'Private Function CustTypeName(lType As Long) As String
' ' This function simply maps string names to the
' ' VARIANT type of a custom property.
' Select Case lType
' Case 1
' CustTypeName = "String"
' Case 2
' CustTypeName = "Long"
' Case 3
' CustTypeName = "Double"
' Case 4
' CustTypeName = "Boolean"
' Case 5
' CustTypeName = "Date"
' Case Else
' CustTypeName = "Unknown"
' End Select
'End Function
'
'Private Sub EnableItems(bEnable As Boolean)
' TextBox3.Enabled = bEnable
' TextBox1.Enabled = bEnable
' TextBox2.Enabled = bEnable
' TextBox6.Enabled = bEnable
' TextBox7.Enabled = bEnable
' ListBox2.Enabled = bEnable
' ListBox3.Enabled = bEnable
' CommandButton2.Enabled = bEnable
'End Sub
'
'
'
'Private Sub UserForm\_Click()
'
'End Sub**
