DBF Datei öffnen Speichern in VBA (Macro)

hi

ich habe mit einem kleinen VBA Programm eine dbf datei erstellt nun würde ich diese gerne mir auf knopfdruck anzeigen lassen.

um die dbf datei anzeigen zu lassen habe ich folgendes gefunden :

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

leider scheint dies nicht zu funktionieren.




ein shape file konnte ich mit folgendem code öffnen



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)


kann mir hier bei vieleicht jemand helffen bin neu in der thematik und blicke noch nicht durch

könntet ihr mir eventuell

für das Speichern mir einen Tip geben

schon mal Danke

Gruß

Flo