My company uses short URLs for marketing campaigns, which redirect to URLs with tracking. For example:
example.com/campaign
will redirect to:
example.com/utm_source=one&utm_medium=two&utm_term=three&utm_content=four&utm_campaign=five
I have an excel file with a list of short URLs, but the tracking URLs are not listed. The current process is to manually open each link and copy the URL.
Is there a way to copy the tracking URLs into excel using VBA?
So far I've explored the following:
Dim ie As Object
Set ie = CreateObject("Internetexplorer.Application")
ie.Navigate Cells(1, 1)
But I can't find a way to then copy the new URL back into excel.
I've also tried:
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
However this just (unsurprisingly) brings back the original hyperlink.
How can I bring back the tracking URL? Ideally without having to install any other software (as my company's IT department is a nightmare) but if that's the only option then so be it.
I believe this will do what you want:
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")
I got the idea from this other answer.
What you are trying to do is get the location you're redirecting to.
Redirects follow a standard process described here... and I'm just grabbing the appropriate header from the response.
You want the .LocationURL property
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
Related
Issue Description:
I have a complex VBA code for web scraping - using it to open Web Page, update fields by using GetElementById and then click "Save" button on specific page to create a new record.
There is only one Element, where I need to select with VBA 1 of 7 options called "Full R" from the list menu, but after I inspected Element on web page I'm not sure how to achieve it, as there are no Options available in Inspected Element (see screenshot below).
Here is the Element Inspected:
My Element id is "TakeoverCorporateActionType" and on web page I can choose from 7 different options when I click on dropbox menu
My goal is always to select same option "Full R" from 7 Options, but i'm not entirely sure how to do it.
There is a full private_sub I'm running as part of more complex code (believe this will enough to understand
Private Sub UpdateFXDATA(client As String, url As String, postNow As Boolean, finalRate As Boolean)
Dim editUrl As String, caUrl As String
Dim element As Variant
editUrl = "MY URL" 'hidden from security reasons
caUrl = "My URL 2" 'hidden from security reasons
lastRow = ws.Range("E12389").End(xlUp).Row
Set ie = GrabIE(ie, url)
Do While ie Is Nothing
Application.Wait (DateAdd("s", 1, Now))
MsgBox "please login to " & url & " in Internet Explorer."
Loop
For Each c In ws.Range("K3:K" & lastRow)
Application.Goto c
If c.Offset(0, 3).Value <> "Data Not Found" Then
On Error GoTo 0
Else
ie.Navigate url & editUrl
waitIE ie
Application.Wait (DateAdd("s", 1, Now))
ie.Document.getelementbyid("TakeoverCorporateActionType").Value = "Full Redemption"
ie.Document.getelementbyid("ExDate").Value = c.Offset(0, -4).Value
ie.Document.getelementbyid("ExDatecutoff1").Value = c.Offset(0, -4).Value
ie.Document.getelementbyid("RecordDate").Value = c.Offset(0, -4).Value
ie.Document.getelementbyid("ActionRequiredDate").Value = c.Offset(0, -4).Value
ie.Document.getelementbyid("InstrumentCode").Value = c.Value
ie.Document.getelementbyid("UnitOfOldStock").Value = 1
ie.Document.getelementbyid("NewShares").Value = 0
ie.Document.getelementbyid("ExternalEventIdentifierGenericOption1").Value = c.Offset(0, -2).Value
ie.Document.getelementbyid("Compulsory").Value = 1
If c.Offset(0, 2).Value = "" Then
ie.Document.getelementbyid("CashAmount").Value = 0.001
Else
ie.Document.getelementbyid("CashAmount").Value = c.Offset(0, 2).Value
End If
End If
Application.Wait (DateAdd("s", 0.5, Now))
ie.Navigate ("javascript:btnSave_Click();")
Application.Wait (DateAdd("s", 1, Now)) 'added additional time to prevent fail
Next c
The Part of the code focused on my problem relates to this line:
ie.Document.getelementbyid("TakeoverCorporateActionType").Value = "Full Redemption"
Problem resolved. Issue was on my side, when I inspect Element, there were no options visible in the code, while when I opened whole view-source I could see them and saw that option names have different names, that's why my code couldn't work.
So this code works fine:
ie.Document.getelementbyid("TakeoverCorporateActionType").Value = "FullRedemption"
I'm trying to scrape zip codes from Google. I've been trying to put innertext into a cell, but I think I may be getting a variable mismatch on 2nd to last line.
'This Must go at the top of your module. It's used to set IE as the active window
Sub Automate_IE_Enter_Data()
'This will load a webpage in IE
Dim i As Long
Dim URL As String
Dim IE As Object
Dim objElement As Object
Dim objCollection As Object
Dim HWNDSrc As Long
Dim adds As Variant, add As Variant
Dim addt As String
'Create InternetExplorer Object
Set IE = CreateObject("InternetExplorer.Application")
'Set IE.Visible = True to make IE visible, or False for IE to run in the background
IE.Visible = True
'Define URL
URL = "https://www.google.com/search?ei=djKhW7nELYqs8AO96baoAw&q=1000 Westover Rd kansas city, Mo"
'Navigate to URL
IE.Navigate URL
' Statusbar let's user know website is loading
Application.StatusBar = URL & " is loading. Please wait..."
' Wait while IE loading...
'IE ReadyState = 4 signifies the webpage has loaded (the first loop is set to avoid inadvertantly skipping over the second loop)
Do While IE.ReadyState = 4: DoEvents: Loop
Do Until IE.ReadyState = 4: DoEvents: Loop
'Webpage Loaded
Application.StatusBar = URL & " Loaded"
'Get Window ID for IE so we can set it as activate window
HWNDSrc = IE.Hwnd
'Set IE as Active Window
'SetForegroundWindow HWNDSrc
Debug.Print "ihgc"
'Unload IE
endmacro:
Set adds = IE.Document.getElementsbyClassName("desktop-title-subcontent")
For Each add In adds
Debug.Print add.innertext
Next
Cells(2, f).Value = add.innertext
End Sub
Couple of things. First and foremost, your loop is unnecessary. I ran your code, and there's nothing to loop. Even if it was necessary, it's being used improperly.
So, in assuming that you in fact do not need a For...Next loop, then you can use the index number of 0 for your collection of IE.Document.getElementsbyClassName("desktop-title-subcontent"), then set your cell reference equal to the innerText property of that collection item.
This brings me to the next issue, your cell reference. Cells(2, f), the f is not a declared variable. If you where actually wanting to use the column "F", then you need to enclose 'F' in double quotes:
Cells(2, "F") or use the column's index of 6, Cells(2, 6)
So, replace this entire portion:
Set adds = IE.Document.getElementsbyClassName("desktop-title-subcontent")
For Each add In adds
Debug.Print add.innertext
Next
Cells(2, f).Value = add.innertext
with this:
Cells(2, "F").Value = IE.Document.getElementsByClassName _
("desktop-title-subcontent")(0).innerText
OPTIONAL
And lastly, I would look into using Early Binding over late binding. It has many advantages, with a possible notable speed improvement.
You would need to set a reference to Microsoft Internet Controls and declare IE as type InternetExplorer vs Object. But that's not going to make or break your code.
I'm trying next to click a link to view information on a page using VBA to then move on to edit that information with VBA, But trying to figure out how to write the code for it as the ID information changes with each search,
Any ideas on this?
I've looked around and can't seem to understand how to get VBA to pick this line up as the (ID=) and it isn't joined to the same ID as I'm searching for.
There is also serval references for
This is the line of code.
View
This is my current code to do the search for it. Without clicking on the view section yet.
Sub Test()
Dim ie As Object
Dim form As Variant
Dim button As Variant
Dim LR As Integer
Dim var As String
LR = Cells(Rows.Count, 1).End(xlUp).Row
For x = 2 To LR
var = Cells(x, 1).Value
Set ie = CreateObject("internetexplorer.application")
ie.Visible = True
With ie
.Visible = True
.navigate "*******"
While Not .readyState = READYSTATE_COMPLETE
Wend
End With
'Wait some to time for loading the page
While ie.Busy
DoEvents
Wend
Application.Wait (Now + TimeValue("0:00:02"))
ie.document.getElementById("quicksearch").Value = var
'code to click the button
Set form = ie.document.getElementsByTagName("form")
Application.Wait (Now + TimeValue("0:00:02"))
Set button = form(0).onsubmit
form(0).submit
'wait for page to load
While ie.Busy
DoEvents
Wend
Next x
End Sub
Edited
I've added in the code I think it should be following that link and a bit of tinkering to get it to not error with compiler errors :D, All seems to work but when it get's to the line to click the link it doesn't fail but doesn't even click it. It will then move on to the next one in the list in the spreed sheet, Which is expected.
Following it through with the debugger that shows nothing erroring or failing which is what I expect it to do if the code was wrong or link,
Any help, please ?
This is the code now
Sub Test1()
Dim ie As Object
Dim form As Variant
Dim button As Variant
Dim LR As Integer
Dim var As String
LR = Cells(Rows.Count, 1).End(xlUp).Row
For x = 2 To LR
var = Cells(x, 1).Value
Set ie = CreateObject("internetexplorer.application")
ie.Visible = True
Dim a
Dim linkhref
linkhref = "/?do_Action=ViewEntity&Entity_ID"
With ie
.Visible = True
.navigate "*******"
While Not .readyState = READYSTATE_COMPLETE
Wend
End With
'Wait some to time for loading the page
While ie.Busy
DoEvents
Wend
Application.Wait (Now + TimeValue("0:00:02"))
ie.document.getElementById("quicksearchbox").Value = var
'code to click the button
Set form = ie.document.getElementsByTagName("form")
Application.Wait (Now + TimeValue("0:00:02"))
Set button = form(0).onsubmit
form(0).submit
'wait for page to load
While ie.Busy
DoEvents
Wend
Application.Wait (Now + TimeValue("0:00:02"))
For Each a In ie.document.getElementsByTagName("a")
If (a.getAttribute("href")) = ("/?do_Action=ViewEntity&Entity_ID=") Then
a.Click
Exit For
Application.Wait (Now + TimeValue("0:00:02"))
While ie.Busy
DoEvents
Wend
End If
Next
Next x
End Sub
This is a copy of the code around the buttons,
This is the code surrounding the buttons,
View
Decom
Log</td>
Thank you.
Use a For to check every <a> tag element and make sure you click the right one. It's true your ID changes, but rest of string is constant, so that's 1 factor. Also, it looks like you always will click where it says View so that's another constant.
With both options, we can develop a simple For..Next that will check every <a> element and will check if those 2 options requirements are fulfilled:
For Each a In ie.document.getElementsByTagName("a")
If Left(a.href, 37) = "/?do_Action=ViewEntity&Entity_ID=" And a.innerText = "View" Then
a.Click
Exit For
Next a
Try it and let's see if this works for you.
If the element href is something like "/?do_Action=ViewEntity&Entity_ID=14287", this if statement is never going to evaluate to True:
(a.getAttribute("href")) = ("/?do_Action=ViewEntity&Entity_ID=")
So the element will never be clicked.
If you know the Entity_ID you want to click you can do:
Dim Entity_ID as Integer
Entity_ID = 14287
If (a.getAttribute("href")) = "/?do_Action=ViewEntity&Entity_ID=" & Cstr(myID) Then a.click
Otherwise just check if the element href contains that url:
If InStr(1, a.getAttribute("href"), linkhref) > 0 Then a.click
EDIT
Ok, using the HTML you posted I am able to access the specified a tag that you requested, by doing this
For Each ele In ie.document.getElementById("searchresults").getElementsByTagName("a")
If InStr(1, ele.href, "do_Action=ViewEntity") > 0 Then
MsgBox "The button is found!"
End If
Next
I setup a simple script to loop through cells in an array, copy/paste each to the end of a URL, and import data from each URL into each sheet. It's creating new sheets as it goes.
It's basically like this...
Set rng = Sheets("IDs").Range("A2:A4")
For Each cell In rng
' DO STUFF HERE
Next cell
My question is this. How can I get the script to look drill into each href and extract the data from there? Each href has the string 'Upload*' in the name. So, I don't even know if this is possible, but I would like to get my script to drill into each link with 'Upload*' (and wildcard), copy/paste data into Worksheet, go back to the original URL, look for another link with 'Upload*' and so on and so forth. It would definitely be a recursive script, for sure. Is this possible, or is this just a waste of time?
I'm guessing it would look something like this, but the code below doesn't work for me.
strSQL = "https://la_de_da_de_da_CampaignID=" & cell.Value
Set IE = CreateObject("InternetExplorer.Application")
With IE
.Visible = True
.Navigate strSQL
Do Until .ReadyState = 4: DoEvents: Loop
Set doc = IE.Document
For Each l In doc.getElementsByTagName("a")
If l.ClassName Like "Upload*" Then
l.Click
End If
Next l
End With
Next cell
I'm getting an error message that reads: 'Run-time Error 13 Type Mismatch'
This line throws the error:
For Each l In doc.getElementsByTagName("a")
I got it working with this.
strSQL = "https://la_de_da_de_da_CampaignID=" & cell.Value
Set IE = CreateObject("InternetExplorer.Application")
With IE
.Visible = True
.Navigate strSQL
Do Until .ReadyState = 4: DoEvents: Loop
Set ElementCol = IE.Document.getElementsByTagName("a")
For Each link In ElementCol
Debug.Print link.innerHTML
If link.innerHTML Like "Upload*" Then
link.Click
Exit For
End If
Next link
End With
I'm trying to use Excel VBA to pull the info from columns A2-D2 and enter it into the web site and then click the "Next" button. The code below is what I have so far which works fine for entering the info found on row 2 only.
I'm hoping to achieve that IE opens a new window, enters the values in cells A2 through D2, clicks the "Next" button, and then loops to open another new IE window and enters the values in cells A3 through D3 until it hits an empty cell.
Here are the current numbers that I'm using for testing, http://imgur.com/a/88XEF.
Thanks in advance for any suggestions.
Sub FillInternetForm()
Dim IE As Object
Set IE = CreateObject("InternetExplorer.Application")
'create new instance of IE. use reference to return current open IE if
'you want to use open IE window. Easiest way I know of is via title bar.
IE.Navigate "https://mygift.giftcardmall.com/Card/Login?returnURL=Transactions"
'go to web page listed inside quotes
IE.Visible = True
While IE.busy
DoEvents 'wait until IE is done loading page.
Wend
'pause if needed
Application.Wait Now + TimeValue("00:00:02")
IE.Document.All("CardNumber").Value = ThisWorkbook.Sheets("sheet1").Range("a2")
IE.Document.All("ExpirationMonth").Value = ThisWorkbook.Sheets("sheet1").Range("b2")
IE.Document.All("ExpirationYear").Value = ThisWorkbook.Sheets("sheet1").Range("c2")
IE.Document.All("SecurityCode").Value = ThisWorkbook.Sheets("sheet1").Range("d2")
'presses the next button
Set tags = IE.Document.GetElementsByTagname("Input")
For Each tagx In tags
If tagx.Value = "Next" Then
tagx.Click
Exit For
End If
Next
End Sub
You just need to wrap your code in a loop..
Dim i as integer
i = 2
do while (ThisWorkbook.Sheets("sheet1").cells(i, 1).value <> "")
'your code from Application.wait line to end of next button click
i = i + 1
loop
This assumes an empty row can be identified by column A being empty. You could change the condition on the while loop if this assumption is bad
sorry had to right a new answer because the formatting was going weird
ok makes sense, you just need to move the start of your loop further up the code so it encases the creation of the IE object and the navigation, you should also close the IE window before opening a new one:
move the chunk:
Dim i as integer
i = 2
do while (ThisWorkbook.Sheets("sheet1").cells(i, 1).value <> "")
right up to the top right after:
Sub FillInternetForm()
Add the following lines after the line "Next" right at the bottom but still enclosed by the loop
IE.Quit
Set IE = Nothing
I was able to accomplish what I wanted with the following. Thanks to those that commented.
Sub FillInternetForm()
Range("A2").Select
Do Until IsEmpty(ActiveCell)
Dim IE As Object
Set IE = CreateObject("InternetExplorer.Application")
'create new instance of IE. use reference to return current open IE if
'you want to use open IE window. Easiest way I know of is via title bar.
IE.Navigate "https://mygift.giftcardmall.com/Card/Login?returnURL=Transactions"
'go to web page listed inside quotes
IE.Visible = True
While IE.busy
DoEvents 'wait until IE is done loading page.
Wend
'pause if needed
Application.Wait Now + TimeValue("00:00:02")
IE.Document.All("CardNumber").Value = ActiveCell.Value
ActiveCell.Offset(0, 1).Select
IE.Document.All("ExpirationMonth").Value = ActiveCell.Value
ActiveCell.Offset(0, 1).Select
IE.Document.All("ExpirationYear").Value = ActiveCell.Value
ActiveCell.Offset(0, 1).Select
IE.Document.All("SecurityCode").Value = ActiveCell.Value
ActiveCell.Offset(1, -3).Select
'presses the next button
Set tags = IE.Document.GetElementsByTagname("Input")
For Each tagx In tags
If tagx.Value = "Next" Then
tagx.Click
Exit For
End If
Next
Loop
End Sub