Question

我想打印从网页下载的文档，文档已在IE浏览器中打开（检查元素选项不存在）使用send keys我可以打印它，但如果文件大小更多打印时显示正在进行打印。 Application.Wait 不会帮我确定等待时间，请建议有没有办法暂停执行宏直到打印进度完成？

用于打印的功能：

Function Sample(tet As Variant)
Dim IE_Tab As SHDocVw.InternetExplorer, ie As InternetExplorer
Dim HTML_Doc As MSHTML.HTMLDocument
Dim SH_Win As SHDocVw.ShellWindows, sh As Object
Dim T_Str As String
Set SH_Win = New SHDocVw.ShellWindows

 For Each IE_Tab In SH_Win
     T_Str = IE_Tab.LocationURL
       If T_Str = tet Then
         Application.Wait (Now + TimeValue("00:00:05"))
         Set sh = CreateObject("WScript.Shell")
         'this command just populates the print dialog box, it worked fine only if i print an web page here iam trying to print a document opened as IE
         IE_Tab.ExecWB OLECMDID_PRINT, OLECMDEXECOPT_DODEFAULT, 2, 0
         sh.AppActivate "Print"
         Application.Wait (Now + TimeValue("00:00:02"))
         sh.SendKeys "c", 1
         Application.Wait (Now + TimeValue("00:00:02"))
        sh.SendKeys ("{ENTER}")
         IE_Tab.Quit
            Exit For
     End If
Next
End Function

打印窗口：

进度窗口：

谢谢

Answer 1

在某些Windows functions的帮助下，您可以使用循环来等待＆＃34;等待＆＃34;直到您的＆＃34; Progress＆＃34; 窗口关闭。

API函数必须放在模块的顶部处（或者更好，通过将其放入其自己的模块中来保持整洁。）

import os 

folders_to_be_made = ['Contracts', 'Other Documents']

for dirfile in os.listdir(current_dir):
    # if dirfile is a folder check its content 
    if os.path.isfile(dirfile):
        continue

    lfolders = os.listdir(dirfile)
    # folder "i" empty 
    if lfolders == []:
        for dirtomake in folders_to_be_made:
            os.makedirs(os.path.join(os.path.abspath(dirfile), dirtomake))
        continue

    for folder in lfolders:
        for dirtomake in folders_to_be_made:
            if dirtomake not in lfolders:
                os.makedirs(os.path.join(os.path.abspath(dirfile), dirtomake))

示例用法：

Option Explicit Private Declare Function FindWindow Lib "User32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long Private Declare Function GetWindowText Lib "User32" Alias "GetWindowTextA" (ByVal hWnd As Long, ByVal lpString As String, ByVal cch As Long) As Long Private Declare Function GetWindowTextLength Lib "User32" Alias "GetWindowTextLengthA" (ByVal hWnd As Long) As Long Private Declare Function GetWindow Lib "User32" (ByVal hWnd As Long, ByVal wCmd As Long) As Long Private Declare Function IsWindowVisible Lib "User32" (ByVal hWnd As Long) As Boolean Sub WaitForWindowToClose(winCaption As String) 'pauses code execution until no window caption (title) matches [winCaption] Dim lhWndP As Long, sStr As String Dim foundWindow As Boolean, startTime As Single 'loop through all windows lhWndP = FindWindow(vbNullString, vbNullString) Do While lhWndP <> 0 sStr = String(GetWindowTextLength(lhWndP) + 1, Chr$(0)) GetWindowText lhWndP, sStr, Len(sStr) 'check if this window is a match If InStr(1, sStr, winCaption, vbTextCompare) > 0 Then Debug.Print "Found Window: " & sStr & " (#" & lhWndP & ")" foundWindow = True Exit Do End If lhWndP = GetWindow(lhWndP, 2) Loop If Not foundWindow Then Debug.Print "Window '" & winCaption & "' not found." Exit Sub End If 'check if window still exists Do While FindWindow(vbNullString, sStr) <> 0 And IsWindowVisible(lhWndP) 'pause for a quarter second before checking again startTime = Timer Do While Timer < startTime + 0.25 DoEvents Loop Loop Debug.Print "Window no longer exists." End Sub

...暂停代码的执行，直到 WaitForWindowToClose "progress" 中的 progress 没有打开的窗口。标题栏。

该过程查找不区分大小写，部分匹配，因为窗口标题并不总是它们看起来像。

这不应该是一个问题，除非你打开另一个窗口，其中有一个类似于你正在等待的标题的窗口。例如， progress 可以引用您的打印机的进度窗口，或称为＆＃34; Progressive Insurance＆＃34;的浏览器窗口。

故障：

以上程序对于上述操作并不是必需的，但我认为无论如何都要包含它们，以便进行故障排除（例如，如果您在识别打印机时遇到问题＆＃ 39;进度窗口）。

用法应该是不言自明的：

Sub ListAllVisibleWindows()
    'Lists all named, visible windows in the Immediate Window
    Dim lhWndP As Long, sStr As String
    lhWndP = FindWindow(vbNullString, vbNullString)
    Do While lhWndP <> 0
        x = x + 1
        sStr = String(GetWindowTextLength(lhWndP) + 1, Chr$(0))
        If Len(sStr) > 1 And IsWindowVisible(lhWndP) Then
            GetWindowText lhWndP, sStr, Len(sStr)
            Debug.Print "#" & x, lhWndP, sStr
        End If
        lhWndP = GetWindow(lhWndP, 2)
    Loop
End Sub

Public Function IsWindowOpen(winCaption As String) As Boolean
    'returns TRUE if winCaption is a partial match for an existing window
    Dim lhWndP As Long, sStr As String
    lhWndP = FindWindow(vbNullString, vbNullString)
    Do While lhWndP <> 0
        sStr = String(GetWindowTextLength(lhWndP) + 1, Chr$(0))
        GetWindowText lhWndP, sStr, Len(sStr)
        If InStr(1, sStr, winCaption, vbTextCompare) > 0 Then
            Debug.Print "Found Window: " & sStr & " (#" & lhWndP & ")"
            IsWindowOpen = True
            Exit Do
        End If
        lhWndP = GetWindow(lhWndP, 2)
    Loop
End Function

_{（代码改编自here。）}

excel vba打印在IE浏览器中打开的文档

1 个答案:

示例用法：

故障：