Excel VBA и windows командная строка - PullRequest
Новая
       53

Excel VBA и windows командная строка

0 голосов
/ 11 марта 2020

Если я наберу это в командной строке windows: 

Find "Foo" "D:\test.txt" | ECHO %ERRORLEVEL%

Я получу 9009 <--- это потому, что он не был найден </p>

Если я наберу это в windows командная строка: 

Find "End" "D:\test.txt" | ECHO %ERRORLEVEL%

Я получаю 0 <--- это потому, что она была найдена </p>

Я хочу отправить эту команду из Excel VBA в командную строку Windows и получить ответ обратно. Вот что я попробовал, и это не работает, но я чувствую, что это близко: 

Sub test()

    Dim cmdLine As Object
    Dim result As String

    Set cmdLine = CreateObject("WScript.Shell")
    result = cmdLine.Exec("%comspec% /C Find ""End of Report"" ""D:\test.csv"" | ECHO %ERRORLEVEL%").STDOut.ReadAll

    Debug.Print (result)

End Sub

1 Ответ

0 голосов
/ 11 марта 2020

Прежде всего вам может понадобиться дождаться, пока wscript завершит sh выполнение команды, поэтому я бы попробовал что-то вроде этого 

Sub test()

    Dim cmdLine As Object
    Dim result As Object

    Set cmdLine = CreateObject("WScript.Shell")

    Set result = cmdLine.Exec("%comspec% /C Find ""End of Report"" ""D:\test.csv"" | ECHO %ERRORLEVEL%")

    Do While result.Status = 0
        Application.Wait Now + TimeValue("00:00:01")
    Loop


    Debug.Print result.stderr.readall(), result.stdout.readall()

End Sub

, чтобы увидеть, что команда действительно работая, вы можете удалить ECHO %ERRORLEVEL% и получите действительно stdout соотв. stderr. 

Sub testA()

    Dim cmdLine As Object
    Dim result As Object

    Set cmdLine = CreateObject("WScript.Shell")

    Set result = cmdLine.Exec("%comspec% /C Find ""End of Report"" ""D:\test.csv""")

    Do While result.Status = 0
        Application.Wait Now + TimeValue("00:00:01")
    Loop


    Debug.Print result.stderr.readall(), result.stdout.readall()

End Sub

Обновление : Если вам нужно только найти определенный текст в файле, вы можете использовать следующий подход 

Sub TestC()
    Debug.Print inFile("D:\Test.csv", "End of Report")
End Sub

Function inFile(fileName As String, searchText As String) As Boolean

    Dim fileContent As String
    Dim fileNo As Long
    fileNo = FreeFile
    Open fileName For Input As #fileNo
    fileContent = Input(LOF(fileNo), fileNo)
    Close #fileNo

    If InStr(1, fileContent, searchText, vbTextCompare) > 0 Then
        inFile = True
    Else
        inFile = False
    End If

End Function

Обновление 2 : Исходя из комментариев, следующий подход может быть решением вашей проблемы 

Sub TestD()
    Dim fileName As String
    fileName = "D:\Test.csv"
    If Not IsFileOpen(fileName) Then
        Debug.Print inFile(fileName, "End of Report")
    End If
End Sub

Function inFile(fileName As String, searchText As String) As Boolean

    Dim fileContent As String
    Dim fileNo As Long
    fileNo = FreeFile
    Open fileName For Input As #fileNo
    fileContent = Input(LOF(fileNo), fileNo)
    Close #fileNo

    If InStr(1, fileContent, searchText, vbTextCompare) > 0 Then
        inFile = True
    Else
        inFile = False
    End If

End Function


Function IsFileOpen(fileName As String)
    Dim filenum As Integer, errnum As Integer

    On Error Resume Next   ' Turn error checking off.
    filenum = FreeFile()   ' Get a free file number.
    ' Attempt to open the file and lock it.
    Open fileName For Input Lock Read As #filenum
    Close filenum          ' Close the file.
    errnum = Err           ' Save the error number that occurred.
    On Error GoTo 0        ' Turn error checking back on.

    ' Check to see which error occurred.
    Select Case errnum

        ' No error occurred.
        ' File is NOT already open by another user.
        Case 0
         IsFileOpen = False

        ' Error number for "Permission Denied."
        ' File is already opened by another user.
        Case 70
            IsFileOpen = True

        ' Another error occurred.
        Case Else
            Error errnum
    End Select

End Function
...