Unable to identify blocks on given layer

I am trying to open Acadfiles and reterieve all the information from the blocks and dump it into access table. where I can update my attributes and again update my drawing as required. This code open the ACAD drawings from a given folder and scroll through each drawing and extract the data by calling fileextractdata procedure. In this procedure when I run this code it does not recogonize some blocks, my block reference variable -- oblockref - remains empty. I have two drawings with one drawing if I select layerblocks the layer which I created the block on works fine and pick all objects. But In other drawings it do not pick blockreference. In the given code I was selecting all the objects on the drawing and then filtering it based on layer. For given layer this code does not work even the block is using the same layer. Could it be because of the name "TEXT-SPECIFICATION"? Is this name too long. But when I keep on moving in the code it picks the right drawing. open it. make it visible and highlight the layers which I filtered in a code. This layer also has a block on it but in code I couldnt reconize any block which was on that layer. Can any one help me on this?










Private Sub cmdRetrieveData_Click()
Dim acadapp As Object
Dim acdocument As Object
Dim aCIR2 As AcadCircle
Dim objcircle As AcadCircle
Dim objdimension As AcadDimension

Dim objss As AcadSelectionSet
Dim intcodes(0) As Integer
Dim varcodevalues(0) As Variant

On Error Resume Next
Set acadapp = GetObject(, "AutoCAD.application")
If Err Then
Err.Clear
Set acadapp = CreateObject("AutoCAD.application")
End If

DoCmd.Hourglass True

'$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$44






strfoldername = "D:\ApprovedDrawings\draws\New Folder\folder1"






If Not objfso.folderexists(strfoldername) Then
MkDir (strfoldername)
End If


With Application.FileSearch

LookIn = strfoldername
Filename = "*.dwg"

'%%%%%%%%% begining part of file search looping program

If .Execute() > 0 Then
MsgBox "There were " & .FoundFiles.Count & _
" file(s) found."
For i = 1 To .FoundFiles.Count
'MsgBox .FoundFiles(I)

'%%%%%%%%%%%%%%%%%%%%%%%%%%%
'strfiletype = .FoundFiles(i)

Call fileExtractiondata(.FoundFiles(i))





' %%%%%%%%%%end part of file search looping code
Next i
Else
MsgBox "There were no files found."
End If
End With

'%%%%%%%%%%%%%%%


Set aCIR2 = Nothing
Set objss = Nothing
Set acdocument = Nothing
Set acadapp = Nothing
DoCmd.Hourglass False


End Sub


':::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::;

Private Sub fileExtractiondata(sfname As String)
Dim acadapp As Object
Dim acdocument As Object

Dim oaccess As Database
Dim orecordset As Recordset
Dim strquery As String
Dim recordno As String
Dim oattrib As AcadAttribute
Dim objss As AcadSelectionSet
Dim objblock As Object
Dim strattrib As String
Dim intcodes(0) As Integer
Dim varcodevalues(0) As Variant
Dim oblockref As AcadBlockReference
Dim ats As Variant
Dim varpick As Variant
Dim apath As String
Dim blkname As String
Dim msgbo As String

On Error Resume Next


Set oaccess = CurrentDb()

strquery = "Select * from Spline_data where DrawingNo =" & 22 'recordno '& "'"

Set orecordset = oaccess.OpenRecordset(strquery)





Set acadapp = GetObject(, "AutoCAD.application")
If Err Then
Err.Clear
Set acadapp = CreateObject("AutoCAD.application")
End If



Set acdocument = acadapp.documents.Open(sfname)
acadapp.Visible = True

intcodes(0) = 8
varcodevalues(0) = "TEXT-SPECIFICATION"



Set objss = acdocument.SelectionSets.Add("filterblocks")
objss.Select acSelectionSetAll, , , intcodes, varcodevalues
objss.Highlight True



orecordset.AddNew

For Each oblockref In objss

ats = oblockref.GetAttributes
Dim EA As AcadAttributeReference
MsgBox oblockref.Name
blkname = oblockref.Name
MsgBox oblockref.Layer


ats = oblockref.GetAttributes
Select Case blkname


Case "SPLINE-DATA"

For i = 0 To UBound(ats)

Set EA = ats(i)
strattrib = (RTrim(ats(i).TagString))
If strattrib = "NO-OF-TEETH" Then
orecordset.Fields(2) = ats(i).TextString
' MsgBox ats(I).TextString

ElseIf strattrib = "TYPE-FIT" Then
orecordset.Fields(3) = ats(i).TextString
ElseIf strattrib = "CLASS-FIT" Then
orecordset.Fields(4) = ats(i).TextString
ElseIf strattrib = "DP-MODULE" Then
orecordset.Fields(5) = ats(i).TextString
ElseIf strattrib = "PD" Then
orecordset.Fields(6) = ats(i).TextString
ElseIf strattrib = "BD" Then
orecordset.Fields(7) = ats(i).TextString
ElseIf strattrib = "PA" Then
orecordset.Fields(8) = ats(i).TextString
ElseIf strattrib = "SPACEWIDTH-T-THICKNESS" Then
orecordset.Fields(9) = ats(i).TextString
ElseIf strattrib = "PIN-D" Then
orecordset.Fields(10) = ats(i).TextString
ElseIf strattrib = "MEASUREMENT-2-PINS" Then
orecordset.Fields(11) = ats(i).TextString
End If

Next i
Case "MATERIALS"
For i = 0 To UBound(ats)
Set EA = ats(i)
strattrib = (RTrim(ats(i).TagString))
If strattrib = "FRICTION-GRADE" Then
orecordset.Fields(14) = ats(i).TextString
' MsgBox ats(I).TextString
ElseIf strattrib = "FRICTION-COLOR" Then
orecordset.Fields(15) = ats(i).TextString
ElseIf strattrib = "FRICTION-NOM" Then
orecordset.Fields(16) = ats(i).TextString
ElseIf strattrib = "CORE-GRADE" Then
orecordset.Fields(17) = ats(i).TextString
ElseIf strattrib = "HARDNESS" Then
orecordset.Fields(18) = ats(i).TextString
End If
Next i

Case "ATTRIBUTES"
For i = 0 To UBound(ats)
Set EA = ats(i)
strattrib = (RTrim(ats(i).TagString))
If strattrib = "GROOVE-PAT" Then
'MsgBox ats(I).TextString
orecordset.Fields(28) = ats(i).TextString
ElseIf strattrib = "DISH HEIGHT" Then
orecordset.Fields(29) = ats(i).TextString
ElseIf strattrib = "WAVES" Then
orecordset.Fields(30) = ats(i).TextString
ElseIf strattrib = "WAVE-HEIGHT" Then
orecordset.Fields(31) = ats(i).TextString
End If
Next i




Case "TOLERANCE"
For i = 0 To UBound(ats)
MsgBox "TOL"
Set EA = ats(i)
strattrib = (RTrim(ats(i).TagString))
If strattrib = "Angular" Then
orecordset.Fields(32) = ats(i).TextString
ElseIf strattrib = "TOL-1PLC" Then
orecordset.Fields(33) = ats(i).TextString
ElseIf strattrib = "TOL-2PLC" Then
orecordset.Fields(34) = ats(i).TextString
ElseIf strattrib = "TOL-3PLC" Then
orecordset.Fields(35) = ats(i).TextString
ElseIf strattrib = "TON-OD" Then
' MsgBox ats(I).TextString
orecordset.Fields(36) = ats(i).TextString
ElseIf strattrib = "TON-ID" Then
orecordset.Fields(37) = ats(i).TextString
ElseIf strattrib = "TON-TOTAL" Then
orecordset.Fields(38) = ats(i).TextString
End If
Next i


Case "DESIGN-LEVEL"

For i = 0 To UBound(ats)
Set EA = ats(i)
strattrib = (RTrim(ats(i).TagString))
If strattrib = "BOM-REV" Then
orecordset.Fields(19) = ats(i).TextString
ElseIf strattrib = "ROUTING-REV" Then
orecordset.Fields(20) = ats(i).TextString
ElseIf strattrib = "REF-BASE" Then
orecordset.Fields(21) = ats(i).TextString
ElseIf strattrib = "DATE" Then
orecordset.Fields(22) = ats(i).TextString
ElseIf strattrib = "DRAWN-BY" Then
orecordset.Fields(23) = ats(i).TextString
ElseIf strattrib = "APPROVED-BY" Then
orecordset.Fields(24) = ats(i).TextString
' MsgBox ats(I).TextString
ElseIf strattrib = "PART-NUMBER" Then
orecordset.Fields("PART-NUMBER") = ats(i).TextString
' MsgBox ats(I).TextString
ElseIf strattrib = "CAGE-CODE" Then
orecordset.Fields(26) = ats(i).TextString
ElseIf strattrib = "SCALE" Then
orecordset.Fields(27) = ats(i).TextString
End If
Next i

Case "MATING-COMPONENTS"
For i = 0 To UBound(ats)
Set EA = ats(i)
strattrib = (RTrim(ats(i).TagString))
If strattrib = "FRICTION-NO" Then
orecordset.Fields(12) = ats(i).TextString
ElseIf strattrib = "SC-NO" Then
orecordset.Fields(13) = ats(i).TextString
End If

Next i
End Select


Next
orecordset.Update
orecordset.Close
acdocument.SelectionSets.Item("filterblocks").Delete



acdocument.Close
Set oblock = Nothing
Set objent = Nothing
Set objss = Nothing

Set oattrib = Nothing
Set oaccess = Nothing
Set orecordset = Nothing
Set acadapp = Nothing
Set acdocument = Nothing

MsgBox "done"
End Sub