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

[Paul_Hossler]

One easy thing to try is to comment out the On Error Goto Error_Handler statement at the beginnng and see where it fails

Personally, I don't like to put an On Error at the beginning (esp On Error Resume Next) but only around very small block of code where I know if I get an error it'll be OK.

Just a thought

[mikeoly]

Thanks!

Edit: Errors I'm getting...

'Error 462: The remote server does not exist" error
'Automation error, Unspecified error"
'Automation error, No more threads can be created in the system"

This occurs when setting NumRows line of Sub ReadExecute().

[Paul_Hossler]

Are you sure that your variables are consistent (tRow instead of tRows for example)

Put Option Explicit at the top of the module and see if it finds any undeclared variables

[Aflatoon]

I'd recommend you never declare a variable As New ...
Always declare and initialize separately and explicitly. So:


Public SoftwareProject as SoftwareSystem

then in your ReadExecute routine, check the variable:


If SoftwareProject Is Nothing then Set softwareproject = new softwaresystem