I wrote this some time ago. Make a list of files with full path and save as a text file. (mj.txt in the example below). Of course you will have to modify some of the code to fit your environment.
Option Base 1
Sub BlockReport()
Dim Filename As String
Dim F As Integer
Dim G As Integer
Dim Block As AcadBlock
Dim BlockType As String
'open files
Close
F = FreeFile()
Open "w:\a\sheet\mj.txt" For Input As #F
G = FreeFile()
Open "w:\a\BlockReport.txt" For Output As #G
Do While Not EOF(F)
Line Input #F, Filename
ThisDrawing.Application.Documents.Open Filename, ReadOnly
For Each Block In ThisDrawing.Blocks
If Left(Block.Name, 1) = "*" Then
'dimension: do nothing
Else
BlockType = "BLOCK"
If Block.IsLayout Then BlockType = "LAYOUT"
If Block.IsXRef Then BlockType = "XREF"
Print #G, Block.Name; Chr$(9); ThisDrawing.FullName; Chr$(9); BlockType
End If
Next Block
ThisDrawing.Application.ActiveDocument.Close , savechanges = False
Loop
Close #F
Close #G
Debug.Print "DONE"
End Sub