Hi Swamp Members,
We have VBA code that allows the user to select an Excel to process and then reads the Excel file and Draws a graphic Column Schedule in AutoCAD. Now when we select the Excel file the code crashes and gives one of the two error messages attached below...!!
This version is using AutoCAD 2013......and Excel 2016 running on Windows 7, 64bit workstations.
Here is the area of the code where the Excel file is selected...!
Private Sub cmdDir_Click()
Dim sProject As String
Dim sProject1 As String
Dim sProject2 As String
Dim sProject3 As String
Dim sProject4 As String
Dim sProj As String
sProject = Trim(Me.txtJobNum)
sProj = Len(sProject)
sProject1 = Left(sProject, 4)
sProject2 = Left(sProject, 5)
sProject3 = Left(sProject, 5)
sProject4 = Mid(sProject, 2, 6)
''''''......Check For Old 4 Character number
If sProj = 4 Then
sDfltDir = "f:\projects\" & sProject & "\Excel\"
End If
'''''''......Check For Old 5 Character Pnumber
If sProj = 5 Then
sDfltDir = "f:\projects\" & sProject & "\Excel\"
End If
'''''''......Check For New 8 Character Pnumber
If sProj = 8 Then
sDfltDir = "f:\projects\" & sProject3 & "\" & sProject & "\Excel\"
End If
'''''''......Check For New 9 Character Pnumber
If sProj = 9 Then
sDfltDir = "f:\projects\" & sProject4 & "\" & sProject & "\Excel\"
End If
Me.CommonDialog1.InitDir = sDfltDir
Me.CommonDialog1.DefaultExt = ".xls"
Me.CommonDialog1.DialogTitle = "Select the SpreadSheet"
Me.CommonDialog1.CancelError = True
Me.CommonDialog1.Filter = "All Files (*.xls)"
Me.CommonDialog1.ShowOpen
Me.lblPath = Mid(Me.CommonDialog1.FileName, 1, Len(Me.CommonDialog1.FileName) - 4)
If Me.lblPath > "" Then
cmdGetFile.Visible = True
Else
cmdGetFile.Visible = False
End If
End Sub
Private Sub cmdGetFile_Click()
Dim MouseChange
Dim strJobNum
Dim strFile
Dim strColTag1
Dim strColTag2 As String
Dim xlWorkBook
Dim xlSheet As Object
Dim intRow
Dim intCol
Dim iFoo As Integer
Dim iNumRws As Integer
Dim intTempNumOfLevels
Dim intNumOfLevels As Integer
Dim intNumOfCols As Integer
Dim TestVar
Dim arrData()
'''''''......Changes the pointer to an hourglass
frmGetFile.MousePointer = fmMousePointerHourGlass
MouseChange = DoEvents
iNumRws = GetRowCnt
ReDim arrData(iNumRws, 8) 'Set the array to the actual size of the Spread Sheet
'''''''......Gets Excel Sheet
Set xlWorkBook = GetObject(lblPath & ".xls")
Set xlSheet = xlWorkBook.worksheets("Combined")
'''''''......Start at Row 2
intRow = 1
intNumOfLevels = 0
intTempNumOfLevels = 1
'''''''......Read Spreadsheet into the array
Do
intRow = intRow + 1
If intRow > iNumRws Then
Exit Do
End If
For intCol = 1 To 8
arrData(intRow, intCol) = xlSheet.Cells(intRow, intCol).Value
If intCol = 7 Or intCol = 8 Then 'If cell is in col 7 or 8 get the integer value not the decimal value
arrData(intRow, intCol) = Int(arrData(intRow, intCol))
End If
Debug.Print arrData(intRow, intCol)
Next intCol
'''''''......Determine max number of levels
strColTag1 = xlSheet.Cells(intRow, 1).Value
If strColTag1 = "" Then
strColTag1 = xlSheet.Cells(intRow, 2).Value
Else
strColTag1 = strColTag1 & "-" & xlSheet.Cells(intRow, 2).Value
End If
TestVar = xlSheet.Cells(intRow + 1, 2).Value
strColTag2 = xlSheet.Cells(intRow - 1, 1).Value
If strColTag2 = "" Then
strColTag2 = xlSheet.Cells(intRow - 1, 2).Value
Else
strColTag2 = strColTag2 & "-" & xlSheet.Cells(intRow - 1, 2).Value
End If
If (strColTag1 = strColTag2) Then
intTempNumOfLevels = intTempNumOfLevels + 1
Else
intTempNumOfLevels = 1
End If
If intTempNumOfLevels > intNumOfLevels Then
If (xlSheet.Cells(intRow + 2, 1).Value <> "") Then
intNumOfLevels = intTempNumOfLevels
End If
End If
Loop
Set xlWorkBook = Nothing
Set xlSheet = Nothing
intNumOfCols = intRow 2
It would be appreciated if anyone could take a look and see if their expertise can identify the problem or make recommendations on how to resolve the difficulty.
Thank you for your cooperation,
Vince