Function YuZheGetTrueUrl(iYuZheUrl)

    'On Error Resume Next

    YuZheGetTrueUrl = ""

    Dim YuZheHttp

    Set YuZheHttp = CreateObject("WinHttp.WinHttpRequest.5.1")

    YuZheHttp.Option(6)=0 '禁止自动跳转

    YuZheHttp.SetTimeouts 5000, 5000, 30000, 5000 '设置超时

    YuZheHttp.Open "GET", iYuZheUrl, False

    YuZheHttp.Send

    If YuZheHttp.Status=302 Then '查找跳转页面

        YuZheGetTrueUrl = YuZheHttp.GetResponseHeader("Location")

    Else

        YuZheGetTrueUrl = iYuZheUrl

    End If

   Debug.Print YuZheHttp.responseText

    Set YuZheHttp=Nothing

End Function