hallo zusammen habe folgendes problem ich möchte gerne die eigenschafften der shapes aus visio in eine access DB 2003 schreiben nun hab ich das problem das er mir die DB erstellt die tabelle auch aber sobald ich Insert über eine eigene fkt. mache gibt er mir Laufzeitfehler 91 Objektvariable oder WIthblockvariable nicht festgelegt aus.
Sub CreateDB()
sDBPAth = "D:\VisCad3.mdb"
sConStr = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & sDBPAth & ";"
' Neues adox objekt
Set oDB = New ADOX.Catalog
oDB.Create sConStr
Set oCn = New ADODB.Connection
oCn.ConnectionString = sConStr
oCn.Open
Set oCM = New ADODB.Command
oCM.ActiveConnection = oCn
oCM.CommandText = "Create Table Shapes ( ID INT,shpName TEXT, PinX INT, PinY INT,Angle INT)"
oCM.Execute
If Not oCM Is Nothing Then Set oCM = Nothing
If Not oCn Is Nothing Then Set oCn = Nothing
If Not oDB Is Nothing Then Set oDB = Nothing
Err_Handler:
If Err <> 0 Then
Err.Clear
Resume Next
End If
End Sub
Public Sub insertIntoDb(s As Visio.Shape)
oCM.CommandText = "INSERT INTO Shapes(i ,shpName, PinX, PinY , Angle) VALUES(id,s.name,s.CellsSRC(visSectionObject, visRowXFormOut, visXFormPinX).FormulaU,s.CellsSRC(visSectionObject, visRowXFormOut, visXFormPinY).FormulaU,s.CellsSRC(visSectionObject, visRowXFormOut, visXFormAngle).FormulaU)"
oCM.Execute
If Not oCM Is Nothing Then Set oCM = Nothing
If Not oCn Is Nothing Then Set oCn = Nothing
If Not oDB Is Nothing Then Set oDB = Nothing
Err_Handler:
If Err <> 0 Then
Err.Clear
Resume Next
End If
End Sub
Public Sub LayCon()
Dim PagObj As Visio.Page
Dim layersObj As Visio.Layers
Dim layerObj As Visio.Layer
Dim shpsObj As Visio.Shapes, shpObj As Visio.Shape
Dim shptmp As Visio.Shape
i = 0
For Each PagObj In ActiveDocument.Pages
Set layersObj = PagObj.Layers
For Each layerObj In layersObj
Set shpsObj = layerObj.Page.Shapes
For Each shpObj In shpsObj
i = i + 1
insertIntoDb shpObj
Debug.Print "SHAPENAME: "; shpObj.name
Debug.Print " "
Debug.Print "Pin X "; shpObj.CellsSRC(visSectionObject, visRowXFormOut, visXFormPinX).FormulaU
Debug.Print "Pin Y "; shpObj.CellsSRC(visSectionObject, visRowXFormOut, visXFormPinY).FormulaU
Debug.Print ""
Debug.Print "Ausrichtung in Grad "; shpObj.CellsSRC(visSectionObject, visRowXFormOut, visXFormAngle).FormulaU
Next
Next
Next
End Sub
wäre super nett
dDanke
|