如果VBA以某个字符串

Question

我有一个用excel制作的下载工具。它导出.bat文件并执行它们。现在我想为它添加一个进度条。

下面的代码工作得很好，除了一件事：它不计算以“ping”正确开头的当前行。

Sub DownloadWithProgressbar()
Dim objShell As Object
Dim objWshScriptExec As Object
Dim objStdOut As Object

Dim objFil3
Dim objFSO
Dim objOSF
Dim obj3liF

Dim rline As String
Dim strline As String

Dim strSearch As String
Dim currentdownloadnum As Long
Dim totaldownloadsnum As Long
Dim progresspercent As Double
Dim pctCompl As Single

Dim filepath As String
Dim filename As String
Dim fileextension As String

filepath = "D:\Eigene Dateien\"
filename = "1"
fileextension = ".bat"

strSearch = "ping"

currentdownloadnum = 0
totaldownloadsnum = 0
progresspercent = 0


Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFil3 = objFSO.OpenTextFile(filepath & filename & fileextension)
Do While Not objFil3.AtEndofStream
    If Left(objFil3.Readline, Len(strSearch)) = strSearch Then
        totaldownloadsnum = totaldownloadsnum + 1
    Else:

    End If
Loop
MsgBox filepath & filename & fileextension & " will download " & totaldownloadsnum & " files." & vbNewLine & "It has " & totaldownloadsnum & " lines starting with the indicator word " & Chr(34) & strSearch & Chr(34) & "."



Set objOSF = CreateObject("Scripting.FileSystemObject")
Set obj3liF = objOSF.OpenTextFile(filepath & filename & fileextension)

'Create Shellobject "cmd.exe"
Set objShell = CreateObject("WScript.Shell")
'Execute file with cmd.exe
Set objWshScriptExec = objShell.Exec(filepath & filename & fileextension)
'Create Outputobject
Set objStdOut = objWshScriptExec.StdOut

'Loop until end of file is reached
Do Until objStdOut.AtEndofStream

    'Number of current Download
    If Left(obj3liF.Readline, Len(strSearch)) = strSearch Then
        currentdownloadnum = currentdownloadnum + 1
    Else
        currentdownloadnum = currentdownloadnum
    End If

    'This line needs to stay, otherwise excel will crash. But its not used at all.
    rline = objStdOut.Readline
    If rline <> "" Then strline = strline & vbCrLf & CStr(Now) & ":" & Chr(9) & rline

'Calculate progress
progresspercent = (currentdownloadnum / totaldownloadsnum) * 100
'give progressbar variable the progress value
pctCompl = progresspercent
'Sending progress to progressbar
progress pctCompl

Loop


'Show content of file in vba message
MsgBox strline

'testing
MsgBox currentdownloadnum & " current" & vbNewLine & totaldownloadsnum & " total"

'Show download completed message
MsgBox "End of file reached: All downloads finished"
End Sub

我需要帮助的部分是：

    'Number of current Download
    If Left(obj3liF.Readline, Len(strSearch)) = strSearch Then
        currentdownloadnum = currentdownloadnum + 1
    Else
        currentdownloadnum = currentdownloadnum
    End If

它会丢回错误的数字。共有4个（在我的例子中），而文件有7个“ping”线。我认为它可能是因为它是一个不同的对象，但不知道如何以另一种方式将其包含在Do Until循环中。

由于批处理文件也有空行和带有其他命令的行，因此不能使用总行数。出于测试目的，我使用“ping”作为“download”命令。

MsgBox rline输出： 空或“D：\ Eigene Dateien \ Eigene Dokumente＆gt; ping 127.0.0.1 -n 6 1＆gt; nul” （或者如果其他内容添加到.bat那么这个内容）

MsgBox obj3liF.Readline输出： 空或“ping 127.0.0.1 -n 6 1＆gt; nul” （或者如果其他内容添加到.bat那么这个内容）

MsgBox Strline输出：

使用本教程中的进度条：http://www.excel-easy.com/vba/examples/progress-indicator.html 其他尝试也非常受欢迎。

Answer 1

循环中有两个.ReadLine，如果文件中有一个奇数行，那么当你到达文件末尾时，其中一行会失败。

未经测试，但我怀疑这是你想要的

'Loop until end of file is reached
Do Until objStdOut.AtEndofStream
    rline = objStdOut.Readline

    'Number of current Download
    ' Based on comment, search is actually for rLine contains strSearch
    'If Left$(rline , Len(strSearch)) = strSearch Then
    If Instr(rLine, strSearch) > 0 Then
        currentdownloadnum = currentdownloadnum + 1
    End If

    If rline <> "" Then strline = strline & vbCrLf & CStr(Now) & ":" & Chr(9) & rline

    'Calculate progress
    progresspercent = (currentdownloadnum / totaldownloadsnum) * 100
    'give progressbar variable the progress value
    pctCompl = progresspercent
    'Sending progress to progressbar
    progress pctCompl
Loop