VBA API Macro Inconsistent

[mikeoly]

Hello! I'm still a relative VBA novice and have a very important task of obtaining large amounts of data out of a software using API. I really need assistance and have run out of resources so I'm turning to my friends here for help!

I'm running into a variety of errors, but I believe that 'no more threads can be created in system' is the culprit. We're using a virtual network, Excel64 bit, and 16GB memory. I have a feeling the process is taking up too many resources and is breaking early. Does anyone have any experience with API or threads? I have no idea where to start

I'm hoping to at least get some suggestions for a more efficient macro -- any ideas?! Would really appreciate any thoughts you may have.

Highlighted is where the code break..

Public SoftwareProject As New SoftwareSystem


Sub DoRead()
       
    Dim file As String, location As String
    Dim product As String
    Dim TableNAme As String
    Dim tabletype As String
    Dim AlternateRangeName As String
    Dim fullpath As String
    Dim Company As String
    Dim Description As String
    Dim parameter As Variant
    Dim rows As Integer
    Dim SheetRows As Integer
    Dim CurrentRow As Integer
    Dim tRow As Integer
    Dim cell As Range
    Dim i As Integer
    Dim j As Integer
    Dim mainworkBook As Workbook
    Dim ws As Worksheet
    Dim NumRows As Integer
    Dim NumCols As Integer
    Dim MyRange As Range
    Dim createsheet As String
    Dim sheetExists As String
    
    On Error GoTo Error_handler
       
    
     Application.ScreenUpdating = False
     Application.Calculation = xlCalculationAutomatic
     Application.DisplayStatusBar = False
     Application.EnableEvents = True
     ActiveSheet.DisplayPageBreaks = False
     
 
    file = ""
    location = ""
    product = ""
    TableNAme = ""
    tabletype = ""
    AlternateRangeName = ""
    fullpath = ""
    Company = ""
    CurrentRow = 1
    NumRows = 0
    NumCols = 0
    tRows = 0
    tCols = 0
    tRow = 2
        
    Sheets("Mylist").Range("eval").Value = Userform.EvalDate.Value
    Sheets("Mylist").Range("TableName").Value = Userform.TableNAme.Value
    
    Set mainworkBook = ActiveWorkbook
    Sheets("Data").Range("Datarange").ClearContents
    parameter = Range("report")
    ParamRows = Range("report").rows.Count - 1
    FileRows = Range("files").rows.Count
    
    For rows = 2 To ParamRows + 1
    
        file = parameter(rows, 1)
        location = parameter(rows, 2)
        product = parameter(rows, 3)
        
        If product = "" Then Exit For
        
        TableNAme = parameter(rows, 4)
        tabletype = ""
        fullpath = location & "\" & file
        parameter(rows, 6) = Replace(parameter(rows, 6), " ", "")
        AlternateRangeName = parameter(rows, 6)
        If FileOrDirExists(location & "\" & file) Then
            Call ReadExecute(CurrentRow, tRow, fullpath, product, TableNAme, tabletype)
        End If
    Next rows
    
    'Refreshfile @ end
    For i = 1 To FileRows
        file = Range("files").Cells(i, 1).Value
        location = Range("files").Cells(i, 2).Value
        If file <> "" And location <> "" And Dir(location & "\" & file & ".apj") <> "" Then
                SoftwareProject.RefreshFile (location & "\" & file & ".apj")
        End If
    Next i
    
    Exit Sub
     Application.ScreenUpdating = True
     Application.Calculation = xlCalculationAutomatic
     Application.DisplayStatusBar = True
     Application.EnableEvents = True
     ActiveSheet.DisplayPageBreaks = False

     
'Refreshfile on error
Error_handler:
    ErrMsg = "ERROR WITH THE TABLE ON ROW " & i
    MsgBox ErrMsg, vbCritical, "ERROR"
    If fullpath <> "" Then
        SoftwareProject.RefreshFile (fullpath)
    End If
    
End Sub

Sub ReadExecute(ByRef CurrentRow As Integer, tRow As Integer, fullpath As String, product As String, TableNAme As String, tabletype As String)
    Dim AlternateRangeName As String
    Dim Company As String
    Dim Description As String
    Dim parameter As Variant
    Dim rows As Integer
    Dim SheetRows As Integer
    Dim cell As Range
    Dim i As Integer
    Dim j As Integer
    Dim mainworkBook As Workbook
    Dim ws As Worksheet
    Dim NumRows As Integer
    Dim NumCols As Integer
    Dim MyRange As Range
    Dim createsheet As String
    Dim sheetExists As String
    
    Sheets("Data").Select
    
    If NumRows = 0 Then
        NumRows = SoftwareProject.NumRows(fullpath, product, "REPORT", TableNAme)
        NumCols = SoftwareProject.NumColumns(fullpath, product, "REPORT", TableNAme)
    Else
    End If
    
        
        If CurrentRow = 1 Then
            Set MyRange = ActiveSheet.Range(Cells(CurrentRow + 1, 4), Cells(CurrentRow + NumRows, 4))
                MyRange.Range(Cells(1, 1), Cells(NumRows, 1)).Value = product
        Else
            Set MyRange = ActiveSheet.Range(Cells(CurrentRow, 4), Cells(CurrentRow + NumRows, 4))
                MyRange.Range(Cells(1, 1), Cells(NumRows, 1)).Value = product
        End If
            
'Column Labels
        If CurrentRow = 1 Then
        Set MyRange = ActiveSheet.Range(ActiveSheet.Cells(CurrentRow, 6), ActiveSheet.Cells(CurrentRow, NumCols + 5))
            HeadersRec = SoftwareProject.ColumnLabels(fullpath, product, "REPORT", TableNAme)
            MyRange.Value = HeadersRec
            'for t data
            
'Row Labels & Table Data
        If CurrentRow = 1 Then CurrentRow = CurrentRow + 1 Else CurrentRow = CurrentRow
        End If
        Set MyRange = ActiveSheet.Range(ActiveSheet.Cells(CurrentRow, 5), ActiveSheet.Cells(CurrentRow + NumRows - 1, 5))
            RowsRec = SoftwareProject.RowLabels(fullpath, product, "REPORT", TableNAme)
            MyRange = Application.Transpose(RowsRec)
    
        
        Set MyRange = ActiveSheet.Range(ActiveSheet.Cells(CurrentRow, 6), ActiveSheet.Cells(CurrentRow + NumRows - 1, NumCols + 5))
            tbleData = SoftwareProject.Data(fullpath, product, "REPORT", TableNAme)
            MyRange.Value = tbleData
        
     
    
       CurrentRow = CurrentRow + NumRows
       file = ""
       location = ""
       product = ""
       TableNAme = ""
       tabletype = ""
       AlternateRangeName = ""
       fullpath = ""
       Set MyRange = Nothing
       
    
End Sub