hi
i created a VBA Macro in with i calculate a dbf table.
now i want by clicking a button that the table open
i found this code but it doesn´t work.
Private Sub CommandButton3_Click()
Dim pDoc As IMxDocument
Set pDoc = ThisDocument
Dim pMap As IMap
Set pMap = pDoc.FocusMap
Dim sDir As String, strTableName As String
sDir = "D:\file\output\NEWTABLE"
strTableName = "T_Test.DBF"
Dim pFact As IWorkspaceFactory
Set pFact = New ShapefileWorkspaceFactory
Dim pWorkspace As IWorkspace
Set pWorkspace = pFact.OpenFromFile(sDir, 0)
Dim pFeatWs As IFeatureWorkspace
Set pFeatWs = pWorkspace
Dim pTable As ITable
Set pTable = pFeatWs.OpenTable(strTableName)
' Create a new standalone table and add it
' to the collection of the focus map
Dim pStTab As IStandaloneTable
Set pStTab = New StandaloneTable
Set pStTab.Table = pTable
Dim pStTabColl As IStandaloneTableCollection
Set pStTabColl = pMap
pStTabColl.AddStandaloneTable pStTab
' Refresh the TOC
pDoc.UpdateContents
End Sub
before i create the dbf file i used a shape file with the next code i opened the shape file
on the same way it should work with the dbf files.
Dim pMXDocument As IMxDocument
Set pMXDocument = ThisDocument
Dim pPfad As String
pPfad = "D:\File\output\NEWTABLE"
Dim pShapefile As String
DBFile = "T_TesT_5"
Dim pwFactory As IWorkspaceFactory
Set pwFactory = New ShapefileWorkspaceFactory
Dim pFeatureWorkspace As IFeatureWorkspace
Set pFeatureWorkspace = pwFactory.OpenFromFile(pPfad, 0)
Dim pFeatureClass As IFeatureClass
Set pFeatureClass = pFeatureWorkspace.OpenFeatureClass(pShapefile)
Dim pFeatureLayer As IFeatureLayer
Set pFeatureLayer = New FeatureLayer
Set pFeatureLayer.FeatureClass = pFeatureClass
pFeatureLayer.Name = "o_length" ' Hier wurde ner neue layer bennant
pMXDocument.AddLayer pFeatureLayer
pMXDocument.ActiveView.Refresh
pMXDocument.UpdateContents
'Dim pMXDocument As IMxDocument
'Set pMXDocument = ThisDocument
Dim pfLayer As IFeatureLayer
Dim pMap As IMap
Set pMap = pMXDocument.FocusMap
Set pfLayer = pMap.Layer(1) 'pMXDocument.SelectedLayer '###############
Dim pFClass As IFeatureClass
Set pFClass = pfLayer.FeatureClass
Dim pFCursor As IFeatureCursor
Set pFCursor = pFClass.Update(Nothing, False)
Dim pFeature As IFeature
Dim aoiApp As Application
Dim aoiDoc As IMxDocument
Dim aoiStandAloneTable As IStandaloneTable
Dim aoiTwin As ITableWindow
Dim aoiTab As IClass
Dim aoiUnknown As IUnknown
Dim aoiFlayer As IFeatureLayer2
Set aoiApp = Application
Set aoiDoc = ThisDocument
Set aoiTwin = New TableWindow
Set aoiFlayer = pMap.Layer(0) ' aoiDoc.SelectedLayer
If aoiFlayer Is Nothing Then
MsgBox " Es ist kein Layer ausgewählt"
Exit Sub
End If
Set aoiTab = aoiFlayer
If aoiTab Is Nothing Then
MsgBox "Auf die Tabelle kann nicht zu gegriffen werden."
Exit Sub
End If
Set aoiTwin.Table = aoiTab
Set aoiTwin.Application = aoiApp
aoiTwin.Show (True)
at the end i want save the file by clicking another button.
could somebody help me
sorry for my bad english
Flo
