In the following code I am trying to rename a block to allow me to reinsert it form a file
but that does not work becuse I get error when I try to insert it.

The code is as follows:
Dim DrawingNames()
Dim DrawingList As New ClassVBDwgFileList
Dim startPnt As Variant
Dim prompt1 As String
Dim InsertBlockName As String

Private Sub CommandButton1_Click()
prompt1 = vbCrLf & "Enter the placement point for block: "
Me.hide
startPnt = ThisDrawing.Utility.GetPoint(, prompt1)
Me.Show
End Sub
Public Sub InstBlock()
Dim startPnt As Variant
Dim prompt1 As String
prompt1 = vbCrLf & "Enter the placement point for block: "
Me.hide
startPnt = ThisDrawing.Utility.GetPoint(, prompt1)
ThisDrawing.ModelSpace.InsertBlock startPnt, "C:\BlockInsert.Dwg", 1#, 1#, 1#, 0
ThisDrawing.Activate
Me.Show
End Sub

Private Sub CommandButton2_Click()
InsertBlockName = "BlockInsert.Dwg"
RenameBlock
MsgBox InsertBlockName
'ThisDrawing.ModelSpace.InsertBlock startPnt, InsertBlockName, 1#, 1#, 1#, 0
ThisDrawing.ModelSpace.InsertBlock startPnt, "C:\BlockInsert.Dwg", 1#, 1#, 1#, 0
ThisDrawing.Activate
Me.hide
End Sub

Private Sub CommandButton3_Click()
Me.hide
Dim zcount As Integer
DrawingList.VBDwgFileList
AutoCAD.Documents.Close
For zcount = 0 To DrawingList.filecount - 1
FileName = DrawingList.VBDwgFileNames(zcount)
If FileName <> "" Then AutoCAD.Documents.Open (FileName)
If Application.Documents.Count = 0 Then
MsgBox "Empty AutoCAD Editor"
Exit Sub
End If
InsertBlockName = "BlockInsert.Dwg"
RenameBlock
MsgBox "startpnt"
ThisDrawing.ModelSpace.InsertBlock startPnt, InsertBlockName, 1#, 1#, 1#, 0
ThisDrawing.Activate
Debug.Print FileName
ThisDrawing.Save 'Save the drawing
ThisDrawing.Close
Debug.Print zcount
If zcount = DrawingList.filecount - 1 Then Exit Sub
Next
Me.Show
End Sub

Public Sub RenameBlock()
Dim strName As String
Dim objBlock As AcadBlock
On Error Resume Next ' handle exceptions inline
'strName = InputBox("Original Block name: ")
strName = "BlockInsert"
If "" = strName Then Exit Sub ' exit if no old name
Set objBlock = ThisDrawing.Blocks.Item(strName)
If objBlock Is Nothing Then ' exit if not found
MsgBox "Block '" & strName & "' not found"
Exit Sub
End If
'strName = InputBox("New Block name: ")
strName = InsertBlockName + "-6"
If "" = strName Then Exit Sub ' exit if no new name
objBlock.Name = strName ' try and change name
If Err Then ' check if it worked
MsgBox "Unable to rename block: " & vbCr & Err.Description
Else
MsgBox "Block renamed to '" & strName & "'"
End If
'InsertBlockName = strName
End Sub