Need help with output redirection from a VBS to TXT or BAT to TXT

[wherbjr35]

Hello again forum,

I am working on a VBA routine that calc and verifies hash files for a series of folders and sub directories, using a command line prog called exactfile.exe (exactfile.com). It is very similar to M$'s FCIV utility, but it is actually supported on Win7/Win8. The issue I am having is that I cannot get the standard output/error/console stream to redirect to a text file. I've written the routine multiple ways, trying to figure out redirection. I was using this site

http://www.robvanderwoude.com/battech_redirection.php

as a reference.

Here is my VBS approach. This code is dependent on another sub passing folder_name as a string

Dim sFSpec As String: sFSpec = "C:\exf\verify_files.vbs"
Dim sParams As String: sParams = "" & folder_name ' this is passed from another sub routine
Dim sCmd As String: sCmd = """" & sFSpec & """ " & sParams
Dim oWSH: Set oWSH = CreateObject("WScript.Shell")
oWSH.Run sCmd, 1, True

The VBS then executes using wscript, however, since exf.exe does not return an exit code the same way FCIV.exe does, I need the results redirected to a text file. The results vary from a single line saying "No errors." or multiple lines indicating which files do not match their original hash.

Here are a couple iterations of my BAT approach, where i use the BAT to call the VBS. I really thought I would be able to use the standard redirect > here, since the executable is launched using cmd.exe, but I've not gotten the results I want.

retval = Shell("C:\exf\testing\verify_files.bat " & fldr_name & ">test.txt 2>&1", vbMinimizedFocus)
retval = Shell("C:\exf\testing\verify_files.bat " & fldr_name, vbMinimizedFocus)

I've scoured more pages than I can count, but no approach seems to work, so far. I would appreciate a second or third set of eyes looking at this with me

Thanks!

WH

 

[John_w]

Try these:

Sub x1()

    Dim sFSpec As String: sFSpec = "C:\exf\verify_files.vbs"
    Dim sParams As String: sParams = "" & folder_name ' this is passed from another sub routine
    Dim sCmd As String: sCmd = """" & sFSpec & """ " & sParams & " > C:\output.txt"
    Dim oWSH: Set oWSH = CreateObject("WScript.Shell")
    
    'Either
    oWSH.Run sCmd, 1, True
    'Or
    'oWSH.Run "%comspec% /c " & sCmd, 1, True

    'Now read C:\output.txt

End Sub


Sub x2()

    Dim sFSpec As String: sFSpec = "C:\exf\verify_files.vbs"
    Dim sParams As String: sParams = "" & folder_name ' this is passed from another sub routine
    Dim sCmd As String: sCmd = """" & sFSpec & """ " & sParams
    Dim oWSH: Set oWSH = CreateObject("WScript.Shell")
    
    Dim wsExec As Object, lines As Variant
    Set wsExec = oWSH.Exec("%comspec% /c " & sCmd)
    lines = Split(wsExec.StdOut.ReadAll, vbCrLf)

End Sub

 

[wherbjr35]

I'm back with a solution that i wanted to share--the two suggestions above did not work out as I expected, so of course I kept digging and prodding. Eventually came to the stackoverflow link below and modded it to suit my needs. The code now captures stdout and redirects it to a text file of my choosing. This overcame my dilemma of having to shell an executable that did not return an exitcode. Now, i just read the text file and perform logic based on the results (logic performed on stdout not shown below)

ms access - WScript Command - Run Minimized? (MSAccess/VBA) - Stack Overflow

'Brief Description
'Launchshell accepts 2 parameters (the first is the full execution path of your program, including any arguments, and in my case, the second parameters was a folder name being passed from another function. The .exec method is used to launch the command, then HideWindow minimizes the command window --The OP on stackoverflow indicated no luck getting a full hidden window, and i couldn't improve on this either. Lastly, I added on a small function (CreateResultsFolder) to check for an output folder, or create one if need be.


'usage

Sub LaunchShell(parameter As String, ByRef folder_name As String)
    Dim objShell As Object
    Dim oExec As Object
    Dim strResults As String

    Set objShell = CreateObject("WScript.Shell")
    Set oExec = objShell.Exec("CMD /K")
    Call HideWindow(oExec.ProcessID)
    Call CreateResultsFolder
    With oExec
        .StdIn.WriteLine "" & parameter & " >c:\tmp\results\" & folder_name & "_log.txt"
        .StdIn.WriteLine "exit"
        While Not .StdOut.AtEndOfStream
            strResults = strResults & vbCrLf & .StdOut.ReadLine
            DoEvents
        Wend
    End With
    Set oExec = Nothing
    Set objShell = Nothing
End Sub

'Copy from here down and paste into a module

Option Explicit
'   ShowWindow() Commands
Private Const SW_HIDE = 0
Private Const SW_MINIMIZE = 6
'GetWindow Constants
Public Const GW_CHILD = 5
Public Const GW_HWNDFIRST = 0
Public Const GW_HWNDLAST = 1
Public Const GW_HWNDNEXT = 2
Public Const GW_HWNDPREV = 3
Public Const GW_OWNER = 4
'   API Functions
Public Declare Function ShowWindow Lib "user32" (ByVal hWnd As Long, ByVal nCmdShow As Long) As Long
Public Declare Function GetWindow Lib "user32" (ByVal hWnd As Long, ByVal wCmd As Long) As Long
Public Declare Function GetDesktopWindow Lib "user32" () As Long
Public Declare Function GetWindowThreadProcessId Lib "user32" (ByVal hWnd As Long, lpdwProcessId As Long) As Long

Public Function HideWindow(iProcessID)
    Dim lngWinHwnd As Long
    Do
        lngWinHwnd = GetHwndFromProcess(CLng(iProcessID))
        DoEvents
    Loop While lngWinHwnd = 0
    HideWindow = ShowWindow(lngWinHwnd, SW_MINIMIZE) 'or SW_HIDE (if it were working correctly)
End Function

Public Function GetHwndFromProcess(p_lngProcessId As Long) As Long
    Dim lngDesktop As Long
    Dim lngChild As Long
    Dim lngChildProcessID As Long
    On Error Resume Next
    lngDesktop = GetDesktopWindow()
    lngChild = GetWindow(lngDesktop, GW_CHILD)
    Do While lngChild <> 0
        Call GetWindowThreadProcessId(lngChild, lngChildProcessID)
        If lngChildProcessID = p_lngProcessId Then
            GetHwndFromProcess = lngChild
            Exit Do
        End If
        lngChild = GetWindow(lngChild, GW_HWNDNEXT)
    Loop
    On Error GoTo 0
End Function

Public Function CreateResultsFolder()
'Creates folder if it does not exist already
    If Len(Dir("C:\tmp\results", vbDirectory)) = 0 Then
       MkDir ("c:\tmp\results")
    Else
    End If
End Function

As always, i am grateful for the input and replies of current and former posters...these forums are invaluable resources. Lastly, I am open to any feedback on how to improve this code. Its 100% working.(well, 99.9 since the cmd window minimizes to taskbar)