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
