Fehler 91: Objektvarialble nicht festgelegt

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