寻找一种在新标签页中加载网址并在完成后更改标题的方法

时间:2014-04-02 20:10:12

标签: vbscript title

我可以在新窗口中加载网址并使用以下内容更改网页标题:

Set IE = CreateObject("InternetExplorer.Application")
set WshShell = WScript.CreateObject("WScript.Shell")
IE.Navigate "http://www.google.com"
IE.Visible = True
While IE.Busy
Wend
While IE.Document.ReadyState <> "complete"
Wend
IE.Document.Title = "yoyo"

有没有办法让它打开新标签而不是新窗口?怎么样?

我正在尝试的另一个传说是:

set WshShell = WScript.CreateObject("WScript.Shell")
url= "http://google.com/"

Set objShell = CreateObject("Wscript.Shell")
objShell.Run(url)
IE.document.title = "yoyo"

这允许我在同一浏览器(IE)上打开新标签,但我无法更改页面标题...

任何帮助都将受到高度赞赏!

1 个答案:

答案 0 :(得分:0)

看这里:

' VB Script Document
' http://stackoverflow.com/questions/22821984/looking-for-a-way-to-load-url-in-new-tab-and-change-the-title-once-done
'
option explicit
On Error Goto 0

Dim strMyUrl    : strMyUrl = "http://www.avg.com" 'strMyUrl = "http://www.jysk.cz" 'strMyUrl = "https://www.google.cz" 'strMyUrl = "www.microsoft.com"

Dim strWTitle   : strWTitle = "yoyo"

Dim strResult   : strResult = WScript.ScriptName ' 

Dim WshShell    : Set WshShell = WScript.CreateObject( "WScript.Shell")
Dim IE              : Set IE = Nothing
Dim oIE             : Set oIE = Nothing

Dim intWExist, BrowserNavFlag, intButton, sRetVal

intWExist = FindIE( strMyUrl, oIE) 'look for MSIE window'

    set IE = oIE

Select Case intWExist
Case 3
    ''' MSIE window found, URL match, window title match
    ''' (not implemented yet)
Case 2
    ''' MSIE window found, URL match
Case 1
    ''' MSIE window found, no URL match
    ''' BrowserNavFlag = 65536 ' navOpenNewForegroundTab
    BrowserNavFlag = 2048 ' navOpenInNewTab
    IE.Navigate2 strMyUrl, CLng( BrowserNavFlag), "_blank"
Case Else
    ''' MSIE window not found
    Set IE = CreateObject( "InternetExplorer.Application")
    BrowserNavFlag = 1
    IE.Navigate strMyUrl    ', CLng( BrowserNavFlag)
End Select

IE.Visible = True

While IE.Busy
    Wscript.Sleep 100
Wend
While IE.Document.ReadyState <> "complete" 'Or IE.ReadyState <> 4
    Wscript.Sleep 100
Wend
    'intButton = WshShell.Popup( "watch how MSIE title change", 1)
If intWExist <> 1 Then
    intWExist = 2
Else
    Set oIE = Nothing
    Set IE = Nothing
    strResult = strResult & vbNewLine & vbTab & "FindIE() pass # 2"
    Wscript.Sleep 2000 'additional time for the Navigate2 method'
    intWExist = FindIE( strMyUrl, oIE) 'get right object for newly created tab'
    If intWExist = 2 Then
        set IE = oIE
    End If
End If

If intWExist = 2 Then
    IE.Document.Title = strWTitle
    sRetVal = "done"
Else
    sRetVal = "'IE.Document.Title = strWTitle' - not renamed"
End If

Set IE = Nothing
Wscript.Echo strResult & vbNewLine & sRetVal ' propagate result

Private Function FindIE( ByVal sUrl, ByRef oObj)
' parameters
' sUrl (input)  string
' oObj (output) object
' returns 
' 0 = any MSIE window not found - or found but not accessible   
' 1 = a MSIE window found
' 2 = 1 and address line match
' 3 = 2 and title match (not implemented yet)
    Dim ww, tpnm, tptitle, tpfulln, tpUrl, tpUrlUnencoded
    Dim errNo, errStr, intLoop, intLoopLimit
    Dim iFound : iFound = 0
    Dim shApp    : Set shApp = CreateObject( "shell.application")
    With shApp
        For Each ww In .windows
            tpfulln = ww.FullName
            strResult = strResult & vbNewLine & ww.Application & vbTab & tpfulln
            If Instr( 1, Lcase( tpfulln), "iexplore.exe", 1) <> 0 Then
                If iFound > 0 Then
                Else
                    Set oObj = ww
                End If
                tptitle = "x x x" : tpUrl = "" : tpUrlUnencoded = ""
                intLoopLimit = 100 ' to look for attributes max. intLoopLimit/10 seconds
                intLoop = 0
                While intLoop < intLoopLimit
                    intLoop = intLoop + 1
                    On Error Resume Next
                    tpnm = typename( ww.document)
                    errNo = Err.Number
                    If errNo <> 0 Then
                        'error if  page not response (yet)' 
                        errStr = "Error # " & CStr( errNo) & " " & Err.Description
                        Wscript.Sleep 100
                    Else
                        iFound = 1
                        intLoopLimit = intLoop  ' end While..Wend loop and preserve loop counter
                        tptitle = ww.document.title
                        tpUrl = ww.document.URL
                        tpUrlUnencoded = ww.document.URLUnencoded
                        errStr = tpnm
                    End If
                    On Error Goto 0
                Wend
                strResult = strResult & vbTab & errStr & " " & CStr( intLoop)
                If Instr( 1, Lcase( tpnm), "htmldocument", 1) <> 0 then
                    strResult = strResult & vbTab & tptitle _
                        & vbNewLine & vbTab & tpUrl _
                        '& vbNewLine & vbTab & tpUrlUnencoded
                    If Instr( 1, Lcase( tpUrl), Lcase( sUrl), 1) <> 0 Then
                        Set oObj = ww
                        iFound = 2
                        strResult = strResult & vbTab & "!match!"
                        ' looking for all matching MSIE URLs 
                        ' this may take considerable time amount
                        ' to speed up script running, uncomment next line "exit for"
                        ' exit for
                    Else
                    End If 
                End If
            Else
                ' a program reports the same shell.application property as "iexplore.exe"
                ' i.e. "explorer.exe"
                ' i.e. "HTML preview" in some editors
                ' etc.
            End If
        Next
    End With
    Set shApp = Nothing
    strResult = strResult & vbNewLine & Cstr( iFound)
    FindIE = iFound
End Function