ListLayers.dvb sample code for AutoCAD

Option Explicit
Dim objDbx As AxDbDocument
' 2000-03-08
' By Jimmy Bergmark
' Copyright (C) 1997-2003 JTB World, All Rights Reserved
' Website: www.jtbworld.com
' E-mail: info@jtbworld.com
' Runs in AutoCAD 2000 with axdb15.dll (must be referenced)
' Example of batch for listing all layers on all drawings in a directory.

Private Sub ListLayers()
Set objDbx = GetInterfaceObject("ObjectDBX.AxDbDocument")
Dim inDir As String
Dim elem As Object
Dim filenom As String
Dim WholeFile As String
Dim newHeight As Double
inDir = "r:\projekt\3828\A"
filenom = Dir$(inDir & "\*.dwg")
Do While filenom <> ""
    ThisDrawing.Utility.Prompt vbCrLf & "File: " & filenom
    ThisDrawing.Utility.Prompt vbCrLf & "-----------------"
    WholeFile = inDir & "\" & filenom
    objDbx.Open WholeFile
    For Each elem In objDbx.Layers
            ThisDrawing.Utility.Prompt vbCrLf & elem.Name
    Next
    Set elem = Nothing
    objDbx.SaveAs WholeFile
    filenom = Dir$
    ThisDrawing.Utility.Prompt vbCrLf
Loop
End Sub