I've cobbled this together from some different codes I've found online, but I'm running into an issue. If anyone ever uses escape to exit the command then it doesn't close the excel file. This means the excel file is simultaneously open and not open, and I have no idea how to close it from inside the program.It's currently deleting the old file, creating a new one, and writing the dimensions to it. I just need to know how to fix this error now, because as it stands if it exits incorrectly it won't let you open the file because it says another user is using it (yourself) but it won't let you close the file because you don't actually have it open.
Option Explicit
Sub Main()
Dim oExcel As Object
Dim oBook As Object
Dim oSheet As Object
'Start a new workbook in Excel
Set oExcel = CreateObject("Excel.Application")
Set oBook = oExcel.Workbooks.Add
Set oSheet = oBook.Worksheets(1)
Dim FileName As String
FileName = "H:\Beam Locations.xlsx"
If Not Dir(FileName) = "" Then Kill (FileName)
'Save the Workbook and Quit Excel
oBook.SaveAs FileName
Call SortDims(FileName, oExcel, oBook, oSheet)
oExcel.Save
oExcel.Quit
End Sub
'\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
'\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
Function SortDims(strFileName, xlApp, xlBook, xlSheet)
Dim oSset As AcadSelectionSet
Dim oEnt As AcadEntity
Dim oDim As AcadDimension
Dim oDimOrd As AcadDimOrdinate
Dim eCnt As Integer
Dim iCnt As Integer
Dim rCnt As Integer
Dim iNdx As Integer
Dim insPnt() As Double
Dim fcode(0) As Integer
Dim fdata(0) As Variant
Dim dxfCode, dxfdata
fcode(0) = 0: fdata(0) = "DIMENSION"
dxfCode = fcode
dxfdata = fdata
Set oSset = ThisDrawing.PickfirstSelectionSet
oSset.Clear
oSset.SelectOnScreen dxfCode, dxfdata
iCnt = oSset.Count
ReDim SelPnt(0 To iCnt - 1, 0 To 3) As Variant
eCnt = 0
For Each oEnt In oSset
Set oDim = oEnt
insPnt = oDim.TextPosition
SelPnt(eCnt, 0) = insPnt(0)
SelPnt(eCnt, 1) = insPnt(1)
SelPnt(eCnt, 2) = insPnt(2)
Set oDimOrd = oEnt
SelPnt(eCnt, 3) = oDimOrd.Measurement
eCnt = eCnt + 1
Next oEnt
ReDim sortPnt(0 To iCnt - 1, 0 To 3) As Variant
sortPnt = ColSort(SelPnt, 1)
Dim irow As Long
irow = 1
With xlSheet
.Range("A:A").NumberFormat = "0.00#"
For iNdx = 0 To UBound(sortPnt, 1)
.Cells(irow, 1) = CStr(sortPnt(iNdx, 3))
irow = irow + 1
Next iNdx
End With
End Function
'\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
'\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
Public Function ColSort(SourceArr As Variant, iPos As Integer) As Variant
Dim Check As Boolean
ReDim tmpArr(UBound(SourceArr, 2)) As Variant
Dim iCount As Integer
Dim jCount As Integer
Dim nCount As Integer
iPos = iPos - 1
Check = False
Do Until Check
Check = True
For iCount = LBound(SourceArr, 1) To UBound(SourceArr, 1) - 1
If SourceArr(iCount, iPos) > SourceArr(iCount + 1, iPos) Then
For jCount = LBound(SourceArr, 2) To UBound(SourceArr, 2)
tmpArr(jCount) = SourceArr(iCount, jCount)
SourceArr(iCount, jCount) = SourceArr(iCount + 1, jCount)
SourceArr(iCount + 1, jCount) = tmpArr(jCount)
Check = False
Next
End If
Next
Loop
ColSort = SourceArr
End Function
'\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
