MyTetra Share
Делитесь знаниями!
Функция для добавления GET-параметра в ссылку (URL)
Время создания: 16.03.2019 23:43
Текстовые метки: Гиперссылки,URL
Раздел: Разные закладки - VBA - Кодировки
Запись: xintrea/mytetra_db_adgaver_new/master/base/151498463213y6c9asy7/text.html на raw.githubusercontent.com

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

  • Макросы VBA Excel
  • Разное
  • Гиперссылки

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

Sub ПримерИспользования()

$ = "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


Так же в этом разделе:
 
MyTetra Share v.0.65
Яндекс индекс цитирования