Run-Time error 80004005 ?

Question

Взял пример скрипта VBA с этого сайта:

Dim wksFact As IWorkspaceFactory
Set wksFact = New ShapefileWorkspaceFactory
Dim wks As IFeatureWorkspace

Set wks=wksFact.OpenFromFile("e:\a.shp",0)

Выдает ошибку 80004005. В руководствах читал что это ошибка получается, когда не найден источник данных. Источник на месте.

В чем тогда дело?

Answer 1

Когда открывается ShapefileWorkspace, нужно указывать фолдер, а не имя шейп-файла. Затем уже из этого Workspace нужно открывать shapefile FeatureClass:

Public Function OpenShapeFile(dir As String, name As String) As IFeatureClass
  Dim pWSFact As IWorkspaceFactory
  Dim connectionProperties As IPropertySet
  Dim pShapeWS As IFeatureWorkspace
  Dim isShapeWS As Boolean

  Set OpenShapeFile = Nothing
 
  Set pWSFact = New ShapefileWorkspaceFactory
  isShapeWS = pWSFact.IsWorkspace(dir)
  If (isShapeWS) Then
    On Error GoTo errhandler
    Set connectionProperties = New PropertySet
    connectionProperties.SetProperty "DATABASE", dir
    Set pShapeWS = pWSFact.Open(connectionProperties, 0)
    Dim pFClass As IFeatureClass
    Set pFClass = pShapeWS.OpenFeatureClass(name)
    Set OpenShapeFile = pFClass
  End If
errhandler:
End Function

Answer 2

Ну спасибо!!!

Answer 3

Пожалуйста!