Hi

in this bit of code is where I originally encountered the problem (see
"BOOKMARK" for workaround) and so limited my self to opening just 10 files
at a time, other wise where the range was large (sometimes 1000, i recall)
the error too many files did appear

I hope I have put in all the called functions - the problem is that it has
never been finished off/tidied up

(Dave, you may seem some of your coding in there somewhere!)

Regards

Tim


Option Explicit
Option Compare Text
Option Base 1

Declare Function GetComputerName& Lib "kernel32" _
Alias "GetComputerNameA" (ByVal lbbuffer As String, nsize As Long)

Public vLineInfo As Variant

Sub IterativeRunNBTstat()

Dim RetVal
Dim Temp
Dim lCount As Long 's/b long?
'Temp = Chr(34) & "<03" & Chr(34) 'for extracting a particular line
Temp = ""

Dim StartMachineNo As Long
Dim EndMachineNo As Long
Dim lTotalNo As Long
Dim sMachineID As String
Dim lLastRow As Long

StartMachineNo = WorksheetFunction.VLookup("StartNumber",
ThisWorkbook.Sheets("Main").Range("A:B"), 2, False)
EndMachineNo = WorksheetFunction.VLookup("EndNumber",
ThisWorkbook.Sheets("Main").Range("A:B"), 2, False)

If EndMachineNo < 1 Then EndMachineNo = StartMachineNo

lTotalNo = EndMachineNo - StartMachineNo + 1

Dim StartTime
StartTime = Now
lLastRow = GetLastRow(2, 2)
Dim iMaxRange
iMaxRange = 10

For lCount = StartMachineNo To EndMachineNo

sMachineID = "ox" & Right("00" & lCount, 6)

'BOOKMARK
If lTotalNo <= iMaxRange Then
ShellAndWait ("command.com /c nbtstat -a " & sMachineID & " " &
Environ$("temp") & "\" & sMachineID & ".txt")
Else '10 more machines, no need for delay while NBTSTAT returns an
answer
RetVal = Shell("command.com /c nbtstat -a " & sMachineID & " " &
Environ$("temp") & "\" & sMachineID & ".txt", 0) ' was 6
'Application.Wait Now() + TimeValue("00:00:04")
End If
Next lCount

If lTotalNo iMaxRange Then
Do Until Now - StartTime TimeValue("00:00:10")
Debug.Print "waiting"
Application.Wait Now + TimeValue("00:00:02")
Loop
End If

For lCount = StartMachineNo To EndMachineNo
sMachineID = "ox" & Right("00" & lCount, 6)

ThisWorkbook.Sheets("Main").Cells(lLastRow + lCount - StartMachineNo +
1, 2) = lCount
ThisWorkbook.Sheets("Main").Cells(lLastRow + lCount - StartMachineNo +
1, 3) = sGetNameCharsSAT(Environ$("temp") & "\" & sMachineID & ".txt")
ThisWorkbook.Sheets("Main").Cells(lLastRow + lCount - StartMachineNo +
1, 5) = vLineInfo
ThisWorkbook.Sheets("Main").Cells(lLastRow + lCount - StartMachineNo +
1, 4) = Now()
Next lCount
ThisWorkbook.Sheets("Main").Cells(lLastRow + lCount - StartMachineNo + 1,
2).Select
Debug.Print Format((Now - StartTime), "hh:mm:ss") & " seconds"
'MsgBox sGetNameCharsSAT("C:\Temp\Test2.txt")
End Sub


Function ReturnName1() As String
Dim z As String * 64
GetComputerName z, 64
ReturnName1 = Left(z, InStr(1, z, Chr(0)) - 1)
End Function

Public Function GetLastRow(FirstCol As Integer, LastCol As Integer) As Long

Dim ColLastRow As Long
Dim i As Integer

For i = FirstCol To LastCol
ColLastRow = Columns(i).Find("*", , , , , xlPrevious).Row 'Finds data
cells, not formatted ones..
If ColLastRow GetLastRow Then GetLastRow = ColLastRow
Next i

End Function

Function sGetNameCharsSAT(sFullFileName As String)
Dim sOutput
Dim iCounter
Dim iPos
Dim iLineNo As Integer
Dim iFileNum As Integer
Dim strTemp As String
Dim Msg As String
Dim sTemp(20) As String
'Environ$("temp") & "\test2.txt "
'get next available file number
iFileNum = FreeFile
'open the file
'Open "C:\windows\desktop\test.txt" For Input As #iFileNum

If FileExists(sFullFileName) = False Then MsgBox "File " & sFullFileName & "
NOT FOUND!!"


Open sFullFileName For Input As #iFileNum
'read the entire first line
On Error Resume Next
Line Input #iFileNum, sTemp(1)

If Err.Number = 62 Then
Close #iFileNum
sOutput = "bombed out"
Else
On Error GoTo 0
If Left(sTemp(1), 4) = "Host" Then
'MsgBox "No data found..."
sGetNameCharsSAT = "Machine not logged onto network"
vLineInfo = ""
Close #iFileNum
Exit Function
End If
On Error Resume Next
For iLineNo = 2 To 18
Line Input #iFileNum, sTemp(iLineNo) 'getting the second line of
input
Next iLineNo
If Err.Number 0 And Err.Number < 62 Then MsgBox "Not normal error -
investigate!!"

On Error GoTo 0
'Range("d6") = sTemp2
For iLineNo = LBound(sTemp, 1) To UBound(sTemp, 1)
Debug.Print iLineNo, sTemp(iLineNo)
Next iLineNo

Close #iFileNum
If Left(sFullFileName, 7) = "C:\Temp" Then Kill sFullFileName
For iCounter = 7 To 18
If InStr(1, sTemp(iCounter), "<03") 0 Then
iPos = InStr(1, sTemp(iCounter), " ")
sOutput = Left(sTemp(iCounter), iPos - 1) '& " Line " & iCounter
vLineInfo = iCounter '" Line with <03 = " &
'instr(1,
End If
Next iCounter

End If



If sTemp(18) = "" Then sOutput = sOutput & ", line 18 null - NO NT user
logged on"
'prob means machine switched on, no user logged on

sGetNameCharsSAT = sOutput

End Function

Public Function FileExists(StFile As String) As Boolean
FileExists = False
On Error Resume Next
If Dir(StFile) < "" Then
If Err.Number = 68 Then 'what is Error 68 - look it up
Err.Clear
On Error GoTo 0
Exit Function
Else
FileExists = True
End If
End If
End Function




"jaf" wrote in message
...
Hi Dave,
It addresses open file resources for all the major o/s's.
I spent awhile on google and saw several mentions of the old "out of
memory"
problem being traced to "to many open files"

There are several API windows error message constants dealing with "to
many
open files", but I didn't see anything about querying for available files.
There must be some or windows wouldn't need an error message.


--

John

johnf202 at hotmail dot com