Раз уж тема коснулась Chrome, пожалуй, опубликую еще один небольшой кусок кода, разработанный вместе с представленным выше. Это пример использования Headless Chrome для получения HTML содержимого страниц. Вероятно, кому-то будет интересно, в качестве альтернативы IE, вопрос пока вроде не особо обсуждался.
Option Explicit
Dim oHeadlessChrome
Set oHeadlessChrome = New clsHeadlessChrome
If oHeadlessChrome.IsAvailable Then
MsgBox oHeadlessChrome.GetContent("https://api.myip.com/")
Else
MsgBox "Headless Chrome недоступен"
End If
Class clsHeadlessChrome
Private psChromePath, pbAvailable
Private Sub Class_Initialize()
Dim bFound, lChromeVersion
CheckChrome bFound, psChromePath, lChromeVersion
pbAvailable = bFound And (lChromeVersion >= 59)
End Sub
Function GetContent(sUrl)
Const BlankPage = "<html><head></head><body></body></html>"
Dim oWshShell, oWshExec, oStdOut, sContent, sCmd
GetContent = ""
If Not pbAvailable Then Exit Function
Set oWshShell = CreateObject("WScript.Shell")
sCmd = """" & psChromePath & """ --headless --disable-gpu --dump-dom " & sUrl
Set oWshExec = oWshShell.Exec(sCmd)
Set oStdOut = oWshExec.StdOut
sContent = oStdOut.ReadAll
If Mid(sContent, 1, Len(BlankPage)) <> BlankPage Then GetContent = sContent
End Function
Public Property Get IsAvailable()
IsAvailable = pbAvailable
End Property
Private Sub CheckChrome(bFound, sChromePath, lChromeVersion)
Dim sUrl, sPath, oWshShell, oWshExec, oStdOut, sContent
bFound = False
' Проверка Chrome в установленных программах
CheckChromeInstall bFound, sChromePath, lChromeVersion
If Not bFound Then
' Проверка Chrome в стандартных папках
CheckChromeFolders bFound, sChromePath, lChromeVersion
End If
End Sub
Private Sub CheckChromeInstall(bFound, sChromePath, lChromeVersion)
' Проверка Chrome в установленных программах
Const HKLM = &H80000002 ' HKEY_LOCAL_MACHINE
Dim oReg, sKey, aSubkeys, sSubkey, iRet, sValue, sInstallLocation, sVersion
bFound = False
Set oReg = GetObject("winmgmts://./root/default:StdRegProv")
For Each sKey In Array("SOFTWARE\Microsoft\Windows\CurrentVersion\Uninstall\", "SOFTWARE\Wow6432Node\Microsoft\Windows\CurrentVersion\Uninstall\")
oReg.EnumKey HKLM, sKey, aSubkeys
If Not IsNull(aSubkeys) Then
For Each sSubkey In aSubkeys
iRet = oReg.GetStringValue(HKLM, sKey & sSubkey, "DisplayName", sValue)
If iRet <> 0 Then oReg.GetStringValue HKLM, sKey & sSubkey, "QuietDisplayName", sValue
If sValue = "Google Chrome" Then
oReg.GetStringValue HKLM, sKey & sSubkey, "InstallLocation", sInstallLocation
oReg.GetStringValue HKLM, sKey & sSubkey, "Version", sVersion
Select Case True
Case IsNull(sInstallLocation)
Case sInstallLocation = ""
Case Not CreateObject("Scripting.FileSystemObject").FileExists(sInstallLocation & "\chrome.exe")
Case IsNull(sVersion)
Case sVersion = ""
Case Not IsNumeric(Split(sVersion, ".", 2)(0))
Case Else
bFound = True
sChromePath = sInstallLocation & "\chrome.exe"
lChromeVersion = CLng(Split(sVersion, ".", 2)(0))
Exit Sub
End Select
End If
Next
End If
Next
End Sub
Private Sub CheckChromeFolders(bFound, sChromePath, lChromeVersion)
' Проверка Chrome в стандартных папках
Dim oFolders, sFolder, sPath, lVersion
bFound = False
Set oFolders = CreateObject("Scripting.Dictionary")
With CreateObject("WScript.Shell")
oFolders.Item(.Environment("process").Item("localappdata")) = ""
oFolders.Item(.Environment("process").Item("programfiles")) = ""
oFolders.Item(.Environment("process").Item("programfiles(x86)")) = ""
oFolders.Item(.Environment("process").Item("programw6432")) = ""
oFolders.Item(.ExpandEnvironmentStrings("%programfiles%")) = ""
oFolders.Item(.ExpandEnvironmentStrings("%programfiles(x86)%")) = ""
End With
With CreateObject("Shell.Application")
oFolders.Item(.Namespace(&H26).Self.Path) = ""
oFolders.Item(.Namespace(&H2A).Self.Path) = ""
End With
For Each sFolder In oFolders
sPath = sFolder & "\Google\Chrome\Application\chrome.exe"
If CreateObject("Scripting.FileSystemObject").FileExists(sPath) Then
lVersion = GetFileVersion(sPath)
If lVersion <> "" Then
bFound = True
sChromePath = sPath
lChromeVersion = lVersion
Exit Sub
End If
End If
Next
End Sub
Private Function GetFileVersion(sPath)
Dim oShell, oFolder, oFile, i, sName, sVersion, sFolderName, sFileName
GetFileVersion = ""
SplitFullPath sPath, sFolderName, sFileName
Set oShell = CreateObject("Shell.Application")
Set oFolder = oShell.Namespace(sFolderName)
Set oFile = oFolder.ParseName(sFileName)
For i = 0 To 511
sName = oFolder.GetDetailsOf(oFolder.Items, i)
If LCase(sName) = "версия файла" Or LCase(sName) = "file version" Then
sVersion = oFolder.GetDetailsOf(oFile, i)
Select Case True
Case sVersion = ""
Case Not IsNumeric(Split(sVersion, ".", 2)(0))
Case Else
GetFileVersion = CLng(Split(sVersion, ".", 2)(0))
Exit Function
End Select
Exit Function
End If
Next
End Function
Private Sub SplitFullPath(sPath, sFolderName, sFileName)
With CreateObject("Scripting.FileSystemObject")
If Not .FileExists(sPath) Then Exit Sub
sFolderName = .GetParentFoldername(sPath)
sFileName = .GetFileName(sPath)
End With
End Sub
End Class
Работает, начиная с версии Chrome 59. Описание прочих возможностей (создание скриншотов страницы и сохранение в формате PDF) и параметров командной строки можно найти по ссылке.
Оговорюсь, что код относительно сыроват, для некоторых страниц нужно отлаживать кодировку символов, и, не исключено, добавлять проверку на таймаут.