Question

我的公司使用短网址进行营销广告系列，该网址会重定向到包含跟踪的网址。例如：

example.com/campaign

将重定向到：

example.com/utm_source=的一个＆安培; utm_medium = 2 ＆安培; utm_term = 3 ＆安培;的utm_content = 4 < /强>＆安培; utm_campaign = 5

我有一个包含短网址列表的Excel文件，但未列出跟踪网址。当前流程是手动打开每个链接并复制URL。

有没有办法使用VBA将跟踪网址复制到Excel？

到目前为止，我已经探讨了以下内容：

Dim ie As Object Set ie = CreateObject("Internetexplorer.Application") ie.Navigate Cells(1, 1)

但我无法找到将新网址复制回excel的方法。

我也尝试过：

Dim link As Hyperlink Cells(1, 1).Select Set link = ActiveSheet.Hyperlinks.Add(Anchor:=Cells(1, 1), Address:=Cells(1, 1)) link.Follow Cells(1, 2) = link.Address

然而，这只是（不出所料）带回原始超链接。

如何恢复跟踪网址？理想情况下，无需安装任何其他软件（因为我公司的IT部门是一个噩梦），但如果这是唯一的选择那么就是它。

Answer 1

我相信这会做你想要的：

Set webClient = CreateObject("WinHttp.WinHttpRequest.5.1")
webClient.Option(6) = False
webClient.Open "GET", Cells(1, 1), False
webClient.send ("")
Cells(1, 2) = webClient.GetResponseHeader("Location")

我从这个other answer得到了这个想法。

您要做的是获取您重定向到的位置。

重定向遵循here所描述的标准流程......我只是从响应中抓取相应的标题。

Answer 2

您需要.LocationURL属性

Const READYSTATE_COMPLETE As Long = 4
Dim IE As Object

Set IE = CreateObject("InternetExplorer.Application")

IE.Navigate Cells(1, 1).Value

'// Wait for page to finish loading
While IE.Busy Or IE.ReadyState <> READYSTATE_COMPLETE
    DoEvents
Wend

Cells(1, 2).Value = IE.LocationURL

将URL从浏览器复制到Excel

2 个答案: