简体   繁体   中英

vbscript using InStr to find info that varies within a URL

I have a project where the user pulls up a specific URL where the values for Dept, Queue, and Day change by what hyperlink they choose. For example, they would click on a hyperlink and the URL would be something like:

http://www.myworkplace.com/UserPlatform/User/Process.aspx?Dept=DeptOne&Queue=18&Day=0

The next hyperlink could be:

http://www.myworkplace.com/UserPlatform/User/Process.aspx?Dept=DeptFive&Queue=13&Day=9 .

I would like to use InStr to find Dept, Queue, and Day within the URL, then set their values to variables, such as UDept , UQueue , and UDay . Depending upon these values, the user can then copy a specific ID number that can only be found on the URL with these values. The end result would be a search for the URL:

http://www.myworkplace.com/UserPlatform/User/Process.aspx?Dept=UDept&Queue=UQueue&Day=UDay

Here's my code so far:

Option Explicit
Dim objIE, objShell, objShellWindows
Dim strIDNum, strURL, strWindow, strURLFound, WShell, i

strURL = "http://www.myworkplace.com/UserPlatform/User/Process.aspx?Dept=DeptOne&Queue=18&Day=0"
strWindow = "Workflow Process"
Set objIE = CreateObject("InternetExplorer.Application")
Set objShell = CreateObject("Shell.Application")
Set objShellWindows = objShell.Windows
Set WShell = CreateObject("WScript.Shell")

strURLFound = False

'To fix item not found error
For Each objIE in objShellWindows
Next

For i = 0 to objShellWindows.Count - 1
    Set objIE = objShellWindows.Item(i)
On Error Resume Next
    If InStr(Ucase(objShellWindows.Item(i).LocationURL), Ucase(strURL)) Then
        If InStr(Ucase(objShellWindows.Item(i).FullName), "IEXPLORE.EXE") Then
            If Err.Number = 0 Then
                If InStr(objShellWindows.Item(i).document.title, (strWindow)) Then
                    strURLFound = True
                    Exit For
                End If
            End If
        End If
    End If
Next

WShell.AppActivate strWindow

WScript.Sleep 300

strIDNum = objIE.document.getElementByID("ID_PlaceHolder").value

Thank you in advance to anyone who can help me with this.

Have you considered using a regular expression?

dim re, s
dim matches

s = "http://www.myworkplace.com/UserPlatform/User/Process.aspx?Dept=DeptFive&Queue=13&Day=9"

Set re = new RegExp
re.Pattern = ".*?Dept=(\w+)&Queue=(\d+)&Day=(\d+)$"
Set matches = re.Execute(s)

Dim uDept, uQueue, uDay
uDept = matches(0).submatches(0)
uQueue = matches(0).submatches(1)
uDay = matches(0).submatches(2)

Msgbox join(array("uDept = " & uDept, "uQueue = " & uQueue , "uDay = " & uDay), vbNewLine)

' Output:
' uDept = DeptFive
' uQueue = 13
' uDay = 9

To replace you can also use a Regular Expression:

Set re = new RegExp
s = "http://www.myworkplace.com/UserPlatform/User/Process.aspx?Dept=DeptFive&Queue=13&Day=9"
newDept = "DeptFourtyTwo"
newQueue = 404
newDay = 12

re.Pattern = "(Dept=)\w+"
newUrl = re.Replace(s, "$1" & newDept)
re.Pattern = "(Queue=)\d+"
newUrl = re.Replace(newUrl, "$1" & newQueue)
re.Pattern = "(Day=)\d+"
newUrl = re.Replace(newUrl, "$1" & newDay)

msgbox newUrl
' output:
' http://www.myworkplace.com/UserPlatform/User/Process.aspx?Dept=DeptFourtyTwo&Queue=404&Day=12

' Alternatively you can replace everything at once if the order and presence of
' parameters is guaranteed:
re.Pattern = "(Dept=)\w+(&Queue=)\d+(&Day=)\d+"
MsgBox re.Replace(s, "$1DeptFourtyTwo$2404$312")     

This only using Instr and Mid Function's

s="http://www.myworkplace.com/UserPlatform/User/Process.aspx?Dept=DeptFive&Queue=13&Day=9"

  a = InStr(s, "?") 'We get the value until ?

    d1 = Mid(s, a)

    c1 = InStr(d1, "=")

    c2 = InStr(d1, "&")

    d2 = Mid(d1, c2 + 1)
    d3 = Mid(d1, c1 + 1, (c2 - c1) - 1) 'value of Dept is d3



    c3 = InStr(d2, "=")
    c4 = InStr(d2, "&")
    d5 = Mid(d2, c4 + 1)

    d4 = Mid(d2, c3 + 1, (c4 - c3) - 1) 'value of Queue is d4

    c6 = InStr(d5, "=")
    d6 = Mid(d5, c6 + 1) ' Value of Day is d6

Hope this helps

The technical post webpages of this site follow the CC BY-SA 4.0 protocol. If you need to reprint, please indicate the site URL or the original address.Any question please contact:yoyou2525@163.com.

 
粤ICP备18138465号  © 2020-2024 STACKOOM.COM