VBA 엑셀매크로 get url parameter

연관글 : javascript get url parameter(http://jpss.ta3ke.com/62 & http://jpss.ta3ke.com/63)

자바스크립트로 url 파라미터를 얻는 걸

엑셀에서 사용할일이 있어서, 작성을 하게되었다.

미흡하지만, 기능적 요구조건은 충족!

Function GETURLPARAM(URL As String, paramname As String)

Dim pnArray() As String         '동적배열선언

Dim result As String            '결과값

result = ""                     '결과값 초기화

Dim strTemp As String           '임시저장용 변수 선언

If (paramname <> "") Then

pnArray = Split(paramname, ",") '받을 변수명 배열로 받음

    For Each pn In pnArray

        strTemp = ""            '임시값 초기화

            With CreateObject("vbscript.regexp")

                .Pattern = "[\\?&]" + pn + "=([^&#]*)" '정규식

                .Global = True  '몽땅 찾기

                .IgnoreCase = True '대소문자 구분 무시

                .MultiLine = True '멀티라인

            If .Test(URL) Then strTemp = .Execute(URL)(0).SubMatches(0) '매치하는 값받고

            End With

            If (strTemp <> result) Then result = result + strTemp '같은값을 제외하고, 추가시킴

    Next

GETURLPARAM = URLDecode(result)

Else

GETURLPARAM = "ERROR:찾는 매개변수가 없습니다."

End If

End Function

'****************************************************************************************

'*

'*  형 식 : Function

'*  정 의 : Public Function URLDecode(URLStr)

'*  설 명 : URLStr 인자로 입력받은 문자열을 URLDecoding 한다.

'*  작 성 : 송원석

'*  날 짜 : 2001.12.03

'*

'****************************************************************************************

Public Function URLDecode(URLStr)

    Dim sURL                '** 입력받은 URL 문자열

    Dim sBuffer             '** Decoding 중의 URL 을 담을 Buffer 문자열

    Dim cChar               '** URL 문자열 중의 현재 Index 의 문자

    Dim Index

On Error Resume Next

    Err.Clear

    sURL = Trim(URLStr)     '** URL 문자열을 얻는다.

    sBuffer = ""            '** 임시 Buffer 용 문자열 변수 초기화.

    '******************************************************

    '* URL Decoding 작업

    '******************************************************

    Index = 1

    Do While Index <= Len(sURL)

        cChar = Mid(sURL, Index, 1)

        If cChar = "+" Then

            '** '+' 문자 :: ' ' 로 대체하여 Buffer 문자열에 추가한다.

            sBuffer = sBuffer & " "

            Index = Index + 1

        ElseIf cChar = "%" Then

            '** '%' 문자 :: Decoding 하여 Buffer 문자열에 추가한다.

            cChar = Mid(sURL, Index + 1, 2)

            If CInt("&H" & cChar) < &H80 Then

                '** 일반 ASCII 문자

                sBuffer = sBuffer & Chr(CInt("&H" & cChar))

                Index = Index + 3

            Else

                '** 2 Byte 한글 문자

                cChar = Replace(Mid(sURL, Index + 1, 5), "%", "")

                sBuffer = sBuffer & Chr(CInt("&H" & cChar))

                Index = Index + 6

            End If

        Else

            '** 그 외의 일반 문자들 :: Buffer 문자열에 추가한다.

            sBuffer = sBuffer & cChar

            Index = Index + 1

        End If

    Loop

    '** Error 처리

    If Err.Number > 0 Then

        URLDecode = ""

        Exit Function

    End If

    '** 결과를 리턴한다.

    URLDecode = sBuffer

    Exit Function

End Function

사용법은

이런식이다.

naver의 검색URL은 query를 사용하고 daum은 q를 사용하니까 몽땅 변수명을 설정해주고

URL에 대고 긁는다.(자동채우기) 그럼 원하는 값을 찾는다.

다른 소스를 참고하여 URL디코딩까지 되게 했다.