Pushing Door Data from ADT to Excel

[pdavis]

first, I am by far not a programmer or VBA expert. I am a hack just trying to get by.

There is a problem with this routine running in ADT. I am trying to push out the door information to excel and everything seems to work, except for the formating of the door size text in excel. I have attached a jpeg of the excel output and the vba code is below.

Thanks.

Option Explicit
Public Sub PushToExcel()
    Dim oExcel As Excel.Application
    Dim oXWorkbook As Excel.Workbook
    Dim oXSheet As Excel.Worksheet
    
    Set oExcel = GetObject(, "Excel.Application")
    Set oXWorkbook = oExcel.ActiveWorkbook
    Set oXSheet = oXWorkbook.ActiveSheet
    
    Dim ent As AcadEntity
    Dim Door As AecDoor
    Dim schApp As New AecScheduleApplication
    Dim cPropSets As AecSchedulePropertySets
    Dim propSet1 As AecSchedulePropertySet
    Dim propSet2 As AecSchedulePropertySet
    Dim propSet3 As AecSchedulePropertySet
    Dim cProps As AecScheduleProperties
    Dim prop As AecScheduleProperty
    Dim i As Integer
    i = 4
   
    oXSheet.Cells(i, 1).NumberFormat = "@"
    oXSheet.Cells(4, 1).Value = "Handle"
'    PROPERTY SET: HNTBDOOR
    oXSheet.Cells(4, 3).Value = "Door No."
    oXSheet.Cells(4, 6).Value = "Type"
    oXSheet.Cells(4, 7).Value = "Material"
    oXSheet.Cells(4, 15).Value = "Fire Rating"
    oXSheet.Cells(4, 8).Value = "Glazing"
    oXSheet.Cells(4, 16).Value = "Remarks"
    oXSheet.Cells(4, 17).Value = "Rev#"
'    PROPERTY SET: HNTBFrame
    oXSheet.Cells(4, 9).Value = "Type"
    oXSheet.Cells(4, 10).Value = "Frame Material"
    oXSheet.Cells(4, 11).Value = "Head"
    oXSheet.Cells(4, 12).Value = "Jamb"
    oXSheet.Cells(4, 13).Value = "Threshold"
    oXSheet.Cells(4, 14).Value = "Set Number"
'    Property Set: HNTBDoorStyles
    oXSheet.Cells(4, 2).Value = "Style"
    oXSheet.Cells(4, 5).Value = "Thickness"
    oXSheet.Cells(4, 4).Value = "Door Size"
    
    
    For Each ent In ThisDrawing.ModelSpace
        If TypeOf ent Is AecDoor Then
            Set Door = ent
            Set cPropSets = schApp.PropertySets(Door)
            Set propSet1 = cPropSets.Item("HNTBDoor")
            Set propSet2 = cPropSets.Item("HNTBFrame")
            Set propSet3 = cPropSets.Item("HNTBDoorStyles")
            If Not propSet1 Is Nothing Then
                i = i + 1
                    Set cProps = propSet1.Properties
                    
                    oXSheet.Cells(i, 1).NumberFormat = "@"
                    oXSheet.Cells(i, 1).Value = cProps.Item("Handle").Value
                    oXSheet.Cells(i, 3).Value = cProps.Item("DoorNumber").Value
                    oXSheet.Cells(i, 6).Value = cProps.Item("Type").Value
                    oXSheet.Cells(i, 7).Value = cProps.Item("Material").Value
                    oXSheet.Cells(i, 15).Value = cProps.Item("FireRating").Value
                    oXSheet.Cells(i, 8).Value = cProps.Item("Glazing").Value
                    oXSheet.Cells(i, 16).Value = cProps.Item("Remarks").Value
                    oXSheet.Cells(i, 17).Value = cProps.Item("Rev#").Value

                    Set cProps = propSet2.Properties
                    
                    oXSheet.Cells(i, 9).Value = cProps.Item("Type").Value
                    oXSheet.Cells(i, 10).Value = cProps.Item("Material").Value
                    oXSheet.Cells(i, 11).Value = cProps.Item("Head").Value
                    oXSheet.Cells(i, 12).Value = cProps.Item("Jamb").Value
                    oXSheet.Cells(i, 13).Value = cProps.Item("Threshold").Value
                    oXSheet.Cells(i, 14).Value = cProps.Item("SetNo").Value
                 
                    Set cProps = propSet3.Properties
                    
                    oXSheet.Cells(i, 2).Value = cProps.Item("Style").Value
                    oXSheet.Cells(i, 5).Value = cProps.Item("Thickness").Value
                    oXSheet.Cells(i, 5).NumberFormat = "# ?/?"
                    oXSheet.Cells(i, 4).Value = cProps.Item("DoorSize").Value
                    
                    
                    
            
                    
                
              End If
        End If
    Next
'If TypeName(data(i)(ii)) = "String" Then
'                    xlsWs.Cells(Row + i, col + ii).NumberFormat = "@"
End Sub

Public Sub PullFromExcel()

    Dim oExcel As Excel.Application
    Dim oXWorkbook As Excel.Workbook
    Dim oXSheet As Excel.Worksheet
    
    Set oExcel = GetObject(, "Excel.Application")
    Set oXWorkbook = oExcel.ActiveWorkbook
    Set oXSheet = oXWorkbook.ActiveSheet
    
    Dim ent As AcadEntity
    Dim Door As AecDoor
    Dim schApp As New AecScheduleApplication
    Dim cPropSets As AecSchedulePropertySets
    Dim propSet1 As AecSchedulePropertySet
    Dim propSet2 As AecSchedulePropertySet
    Dim propSet3 As AecSchedulePropertySet
    Dim cProps As AecScheduleProperties
    Dim prop As AecScheduleProperty
    Dim i As Integer
    i = 4
 
    Do
        i = i + 1
        Set ent = ThisDrawing.HandleToObject(oXSheet.Cells(i, 1))
        If Not ent Is Nothing Then
            If TypeOf ent Is AecDoor Then
                Set Door = ent
                Set cPropSets = schApp.PropertySets(Door)
                Set propSet1 = cPropSets.Item("HNTBDoor")
                Set propSet2 = cPropSets.Item("HNTBFrame")
                Set propSet3 = cPropSets.Item("HNTBDoorStyles")
                
                
                
                If Not propSet1 Is Nothing Then
                    Set cProps = propSet1.Properties
                    
                    cProps.Item("DoorNumber").Value = oXSheet.Cells(i, 3).Value
                    cProps.Item("Type").Value = oXSheet.Cells(i, 6).Value
                    cProps.Item("Material").Value = oXSheet.Cells(i, 7).Value
                    cProps.Item("FireRating").Value = oXSheet.Cells(i, 15).Value
                    cProps.Item("Glazing").Value = oXSheet.Cells(i, 8).Value
                    cProps.Item("Remarks").Value = oXSheet.Cells(i, 16).Value
                    cProps.Item("Rev#").Value = oXSheet.Cells(i, 17).Value
                    
                    Set cProps = propSet2.Properties
                    
                    cProps.Item("Type").Value = oXSheet.Cells(i, 9).Value
                    cProps.Item("Material").Value = oXSheet.Cells(i, 10).Value
                    cProps.Item("Head").Value = oXSheet.Cells(i, 11).Value
                    cProps.Item("Jamb").Value = oXSheet.Cells(i, 12).Value
                    cProps.Item("Threshold").Value = oXSheet.Cells(i, 13).Value
                    cProps.Item("SetNo").Value = oXSheet.Cells(i, 14).Value
                    
                End If
            End If
        End If
    Loop While oXSheet.Cells(i + 1, 1).Value <> ""
    
End Sub