Функция для добавления GET-параметра в ссылку (URL)

Если требуется добавить в URL новый GET-параметр, или заменить значение имеющегося, - можно воспользоваться этой функцией.

Sub ПримерИспользования()
    URL$ = "http://market.yandex.ru/model.xml?modelid=968028&np=0"
 
    URL$ = URL_SetParameter(URL$, "how", "aprice") ' такого параметра нет - он добавляется
    URL$ = URL_SetParameter(URL$, "np", "1") ' такой параметр есть - он заменяется
    
    Debug.Print URL$
    ' на выходе получаем ссылку
    ' <a href="http://market.yandex.ru/model.xml?modelid=968028&hid=512743&how=aprice&np=1
End" title="http://market.yandex.ru/model.xml?modelid=968028&hid=512743&how=aprice&np=1
End">http://market.yandex.ru/model.xml?modelid=968028&hid=512743&how=aprice&n...</a> Sub

Код функции:

Function URL_SetParameter(ByVal URL$, ByVal Param$, ByVal ParamValue$) As String
    ' в качестве параметра принимает исходную ссылку, название GET-параметра, и его значение
    ' находит в ссылке значение GET-параметра, и заменяет на новое
    ' если в ссылке нет GET-параметра Param$ - добавляет его
    ' Возвращает новую ссылку
    On Error Resume Next
    Dim sep$, arr, suffix$
    Select Case True
        Case InStr(1, URL$, "?" & Param$ & "=", vbTextCompare) > 0: sep$ = "?" & Param$ & "="
        Case InStr(1, URL$, "&" & Param$ & "=", vbTextCompare) > 0: sep$ = "&" & Param$ & "="
        Case Else: sep$ = ""
    End Select
 
    If Len(sep$) Then
        ' GET-параметр Param$ присутствует в URL - меняем его значение
        arr = Split(URL$, sep$)
        If UBound(arr) > 1 Then
            URL_SetParameter = arr(0) & sep$ & ParamValue$        ' ошибочная ссылка - 2 одинаковых параметра
        Else
            ' корректная исходная ссылка
            If arr(1) Like "*&*" Then suffix$ = "&" & Split(arr(1), "&", 2)(1)
            URL_SetParameter = arr(0) & sep$ & ParamValue$ & suffix$
        End If
    Else
        ' GET-параметр Param$ отсутствует в URL - добавляем его
        If URL$ Like "*[?]*=*" Then
            URL_SetParameter = URL$ & "&" & Param$ & "=" & ParamValue$
        Else
            URL_SetParameter = URL$ & "?" & Param$ & "=" & ParamValue$
        End If
    End If
End Function

Комментарии

Отправить комментарий

Содержание этого поля является приватным и не предназначено к показу.
CAPTCHA
Подтвердите, пожалуйста, что вы - человек:
          ____   _____       _   ____       _    
_ __ / ___| | ___| | | |___ \ / \
| '__| | | _ | |_ _ | | __) | / _ \
| | | |_| | | _| | |_| | / __/ / ___ \
|_| \____| |_| \___/ |_____| /_/ \_\
Введите код, изображенный в стиле ASCII-арт.

Не получается применить макрос? Не удаётся изменить код под свои нужды?

Оформите заказ у нас на сайте, не забыв прикрепить примеры файлов, и описать, что и как должно работать.