用vb截图一个html文件

Question

我正在处理一组html文件（用一些python代码保存在本地驱动器上），并在这些文件中查找关键字。但是，它们有几页长，我正在努力寻找一种方法，用vba自动执行以下序列：打开文件>查找关键字1>；以关键字1为中心拍摄一张屏幕截图，以x宽y高保存在最佳格式（jpeg？）在本地驱动器上>；转到下一个关键字>；转到下一个文件。在

最终目标是能够在上下文中快速查看这些关键字。如果我设法得到这些文件，我会在我的Excel电子表格中用超链接链接到它们。在

这是我现在的代码-显然它不起作用：

'Get list of files in folder
Dim xRow As Long
Dim xDirect$, xFname$, InitialFoldr$

InitialFoldr$ = "blablabla"
With Application.FileDialog(msoFileDialogFolderPicker)
    .InitialFileName = Application.DefaultFilePath & "\"
    .Title = "Please select a folder to list Files from"
    .InitialFileName = InitialFoldr$

    If .SelectedItems.Count <> 0 Then
    xDirect$ = .SelectedItems(1) & "\"
    xFname$ = Dir(xDirect$, 7)

    Do While xFname$ <> ""
    Sheets("List of files folder").Cells(3, 2).Offset(xRow) = xFname$
    xRow = xRow + 1
    xFname$ = Dir

    Loop
    End If
End With

'Get # rows in list of files in folder
Dim myrng4 As Range
Dim lastlinelist As Integer
Dim htmlpath As String
Dim objWord
Dim objDoc

Set objWord = CreateObject("Word.Application")

Set myrng4 = Sheets("List of files folder").Range("B3:B50000")
lastlinelist = myrng4.Find(What:="*", LookIn:=xlValues, Lookat:=xlWhole, SearchOrder:=xlRows, _
SearchDirection:=xlPrevious).Row

For Each cn In Range(wb.Sheets("Results conso").Cells(3, 11), wb.Sheets("Results conso").Cells(3, Lastcolumn))
For Each fileref In Range(Sheets("List of files folder").Cells(2, 3), Sheets("List of files folder").Cells(2, lastlinelist))
    With Sheets("results conso")
        htmlpath = InitialFoldr$ & fileref
        If Dir(htmlpath) = "" Then
        Else
            If LCase(Right(pdfpath, 4)) <> "html" Then
            Else
                Set objDoc = objWord.Documents.Open(htmlpath)
                objWord.Visible = True
                objDoc.BringToFront
                If objDoc.findText(cn.Value, True, True, False) = False Then
                    objDoc.Close True
                    Set objDoc = Nothing
                Else
                    Call keybd_event(VK_SNAPSHOT, 0, 0, 0)
                    Set objDoc = wordobj.Documents.Add
                    wordobj.Visible = True
                    Set objselection = wordobj.Selection
                    objselection.Paste
                End If
            End If
        End If
    End With
Next fileref
Next cn

另外，我想知道用Python而不是VBA做这件事是否更好。在

非常感谢， 哈德良

Answer 1

找到这个词应该很容易。我写了一个函数来捕捉截图。它可能比你需要的代码更多。它正在查找程序和窗口等

Option Explicit
Private mblnFormActivated As Boolean
Private fsFolder        As New FileSystemObject
Private fsFile          As New FileSystemObject
Private bIsRealClick    As Boolean

Private Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" _
(ByVal hwnd As Long, ByVal lpOperation As String, ByVal lpFile As String, _
ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long

Private Declare Function MapVirtualKey Lib "user32" Alias "MapVirtualKeyA" (ByVal wCode As Long, ByVal wMapType As Long) As Long
Private Declare Sub keybd_event Lib "user32" (ByVal bVk As Byte, ByVal bScan As Byte, ByVal dwFlags As Long, ByVal dwExtraInfo As Long)
Private Const VK_MENU = &H12
Private Const VK_SNAPSHOT = &H2C
Private Const KEYEVENTF_KEYUP = &H2
Private Declare Function GetAsyncKeyState Lib "user32" (ByVal vkey As Long) As Integer

Private Sub cmdScreenshot_Click()
Dim ewohwnd As Long
Dim ewohwnd2 As Long
    'This will capture a screenshot of the EWO window and save it to the job folder.
    ewohwnd = GetHwndFromProcessName("EWO.EXE", "Byers View Station")
    ewohwnd2 = GetHwndFromProcessName("EWO.EXE", "#32770")
    If (ewohwnd2 = 0) Then
        ewohwnd2 = GetHwndFromProcessName("EWO.EXE", "ICL Frame")
    End If

    If ewohwnd = 0 Then
        MsgBox "EWO is not currently running."
        Exit Sub
    End If
    If ewohwnd2 = 0 Then
        MsgBox "validation has not been run"
        Exit Sub
    End If

    DoEvents
    If szJobFolderAlt = "" Then
        Call GetWindowScreenshot(ewohwnd, ewohwnd2, szJobFolder & szJobStatus & " VALIDATION SCREENCOPY.JPG", 1)

        Call ShellExecute(1, "Open", szJobFolder & szJobStatus & " VALIDATION SCREENCOPY.JPG", 0&, 0&, 10)
    Else
        Call GetWindowScreenshot(ewohwnd, ewohwnd2, szJobFolderAlt & szJobStatus & " VALIDATION SCREENCOPY.JPG", 1)

        Call ShellExecute(1, "Open", szJobFolderAlt & szJobStatus & " VALIDATION SCREENCOPY.JPG", 0&, 0&, 10)
    End If
End Sub

这是我模块modWindowsScreenShot中的代码

^{pr2}$