캐드의 문자를 엑셀로 옮기는 것 (퍼옴) 확인 부탁드립니다.

캐드 문자를 엑셀로 옮기는 방법 찾다가 찾은건데요.. 실행하면 자동화오류,치명적오류 하면서..안되더라구요. 처음 몇번은 되던데.. ㅡㅡ;; 확인 부탁드립니다.



Option Explicit

Sub Test()

    Dim oSel As AcadSelectionSet
    ‘기존에 “SelSet” 이름의 셀렉션 셑이 있으면 삭제하고
    On Error Resume Next
    ThisDrawing.SelectionSets(“SelSet”).Delete
    On Error GoTo ErrorHandler
   
    ‘”SelSet”이름으로 개체 지정
    Set oSel = ThisDrawing.SelectionSets.Add(“SelSet”)
   
    ‘문자만을 가져올 필터 작성
    Dim iGcode(0) As Integer
    Dim vData(0) As Variant
   
    iGcode(0) = 0
    vData(0) = “text,mtext”
   
    ‘모든 문자 선택
    oSel.Select acSelectionSetAll, , , iGcode, vData
   
    ‘만약 모든 문자가 아니라 선택을 하고 싶다면
    ‘oSel.SelectOnScreen iGcode, vData
   
    ‘선택한 것이 없으면 종료
    If oSel.Count = 0 Then GoTo ErrorHandler

    Dim oExcel As Object
    Dim oBook As Object  ‘엑셀 실행하는 경우 워크북 추가용
    Dim oSheet As Object
   
    On Error Resume Next
   
    ‘엑셀을 가져오고
    Set oExcel = GetObject(, “Excel.Application”)
   
    ‘가져오는데 에러가 생기면
    If Err.Number <> 0 Then
       
        ‘에러 지우고
        Err.Clear
       
        ‘엑셀 실행
        Set oExcel = CreateObject(“Excel.Application”)
        Set oBook = oExcel.Workbooks.Add      ‘워크북 추가
        Set oSheet = oBook.Worksheets.Item(1) ‘워크시트 활성
       
        ‘엑셀 실행이 안되면
        If Err.Number <> 0 Then
            Err.Clear
            MsgBox “Excel이 설치되지 않았거나.    ” & vbCr & _
                   “Excel을 실행할 수 없습니다.   “, vbInformation
            GoTo ErrorHandler
        End If
    End If
   
    ‘시트가 없으면
    Set oSheet = oExcel.ActiveSheet
    If Err.Number <> 0 Then
        Err.Clear
        MsgBox “Excel에 열린 문서가 없습니다.   “, vbInformation
        GoTo ErrorHandler
    End If
   
    ‘시트가 보호되어 있으면
    If oSheet.ProtectContents Then
        MsgBox “시트가 보호되어 있거나.         ” & vbCr & _
               “Excel에 열린 문서가 없습니다.   “, vbInformation
        GoTo ErrorHandler
    End If
   
    On Error GoTo ErrorHandler
   
    ‘엑셀 활성화
    With oExcel
        .Visible = True
       
        ‘활성화된 시트를 지정하고
        Set oSheet = .ActiveSheet
        Dim obj As AcadEntity
        Dim i As Integer
       
        i = 1
        ‘셀렉션 셑의 문자를 순환하면서
        For Each obj In oSel
            ‘시트의 A1부터 문자 삽입
            oSheet.Range(“A” & i) = obj.TextString
            ‘행 값의 증분
            i = i + 1
        Next
   
    End With
   
    ‘지정한 개체들 메모리에서 해제
    Set oExcel = Nothing
    Set oBook = Nothing
    Set oSheet = Nothing
    Set oSel = Nothing
    Exit Sub

ErrorHandler:
   
    If Err Then
        MsgBox Err.Description
        Err.Clear
    End If
   
    Set oExcel = Nothing
    Set oBook = Nothing
    Set oSheet = Nothing
    Set oSel = Nothing
End Sub