save failed in objectDBX - A2K5

I have the following code that fails on the objdwg.save statement.

Suggestions would be appreciated.

Thanks,
Mike Weaver

'Given a collection of layers , push the properties of each of those layers
out to the target drawing
'including xreffed layers in the target that match the base layer name in
the source
Public Function PushLayersToOne(objSourceLayers As Collection,
strTargetPathName As String) As Integer

'Dim strSourceDwg As String
Dim objDwg As AxDbDocument
Dim intI As Integer
Dim strSourcePath As String
Dim objSourceLayer As AcadLayer
Dim strSourceLayerName As String
Dim objTargetLayers As AcadLayers
Dim objTargetLayer As AcadLayer

Set objDwg = GetInterfaceObject("ObjectDBX.AxDbDocument.16")

'strSourcePath = ThisDrawing.Path & "\Standards\" & ThisDrawing.Name
strSourcePath = ThisDrawing.FullName

'strSourcePath = strSourcePath
If strTargetPathName Like strSourcePath Then GoTo ExitHere
If strTargetPathName = "" Then GoTo ExitHere

objDwg.Open strTargetPathName
Set objTargetLayers = objDwg.Layers

For Each objSourceLayer In objSourceLayers
strSourceLayerName = objSourceLayer.Name
For Each objTargetLayer In objTargetLayers
If objTargetLayer.Name Like "*|" & strSourceLayerName & "*" Then
On Error Resume Next
With objTargetLayer
.Freeze = objSourceLayer.Freeze
.LayerOn = objSourceLayer.LayerOn
.Linetype = objSourceLayer.Linetype
.Lineweight = objSourceLayer.Lineweight
.Lock = objSourceLayer.Lock
'.PlotStyleName = objSourceLayer.PlotStyleName
.Plottable = objSourceLayer.Plottable
.TrueColor = objSourceLayer.TrueColor
.ViewportDefault = objSourceLayer.ViewportDefault
End With
End If
Next objTargetLayer
Next objSourceLayer

Err.Clear
On Error Resume Next
'#########################################################
'### The next statement fails every time
###
'#########################################################
objDwg.Save

If Err.Number = -2147467259 Then GoTo SaveFailed

Set objDwg = Nothing

PushLayersToOne = objSourceLayers.Count

On Error GoTo 0
Exit Function

SaveFailed:
Err.Clear
On Error GoTo 0
MsgBox "The save operation failed on: " & strTargetPathName
Set objDwg = Nothing
Exit Function

ExitHere:
MsgBox "Are you trying to run me in circles?", vbOKOnly, "What???"

End Function

 

unless they fixed it in 2005, .save never worked, try saveas method

 

Is that all it takes?
Thanks Mark. I can say they haven't fixed it in 2005, so I will switch to
saveas.

Mike