Excel VBA find webpage link id - excel

The webpage that I am working with has 60 to 100 menu links on it depending on the users credentials. I use this code to click on the menu link:
Set oapp = CreateObject("Shell.Application")
For i = 0 To 25
StrName = ""
On Error Resume Next
StrName = oapp.Windows(i).Document.URL
If InStr(StrName, "mywebaddress.aspx") Then
Set oie = oapp.Windows(i)
Exit For
End If
Next
oie.Document.all("ctl11_repeaterNavigator_ctl32_menuLink").Click
but the link number changes depending on the users credentials - with my credentials _ctl32 can be _ctl32 or _ctl33 on others. is there a way to search for the inner text and store the link ID as a string?
I know I can click on the link by using:
For i = 1 To oie.Document.all.Length
If oie.Document.all.Item(i).innerText = "Letters" Then
oie.Document.all.Item(i).Click
Exit For
End If
Next i
but I need the link id store in a string for the next step

Perhaps try something like this, assuming the link's Name is "Letters" and also assuming that the the prefix "ctl11_repeaterNavigator_" and suffice "_menuLink" will not change for the users.
Dim ele as Variant
Dim parseString as String
'## Determine what ctl to use:'
For each ele in oie.Document.GetElementsByName("Letters") '## Modify to use the Name associated with this menu link '
If Right(ele.InnerHTML,9) = "_menuLink" AND _
Left(ele.InnerHTML, 24) = "ctl11_repeaterNavigator_" Then
ele.Click
Exit For
End If
Next
May have to use ele.InnerText instead of .InnerHTML so if the above doesn't work, try tweaking it a bit.

Related

Word remains in the background despite the "Active" function VBA

I need to make barcode label sheets for items. For this I use Excel with VBA and a "user form" to help the user in entering the number and information of bar codes. Once I have all my information for my barcodes, I transfer its information to a Word in which I format it to make printable labels.
My system works fine, although a bit long when there are a large number of labels to transfer, but once word and excel have been closed once when I want to restart the transfers, Word no longer comes to the fore , which makes me completely miss the transfer. I am using the tab key which is the main source of the problem.
I have tried performing the same actions as the tab key with other commands like "next" so that it is no longer a problem. However this does not work entirely because the tab key allows at the end of a page to continue the layouts on a new page which the "next" function does not do.
So my questions are: How can I force Word to come to the fore? Can we replace the tab key with another parameter that allows me to do the same thing?
I provide you below the code of my loop performing the transfer.
Dim appwd As Word.Application
Dim oDoc As Object
Dim Code As String, SKU As String, Name As String, Size As String
Dim DerLign As Byte
With Sheets("Reference")
DerLign = .Cells(.Cells.Rows.Count, 1).End(xlUp).Row
End With
On Error Resume Next
Set appwd = GetObject(, "Word.Application")
If Err Then
Set appwd = New Word.Application
End If
On Error GoTo 0
With appwd
If .Documents.Count = 0 Then
.Documents.Add
End If
Set oDoc = .MailingLabel.CreateNewDocument("3474")
.Visible = True
.Activate
' Colle les données dans Word
For i = 8 To DerLign
Code = ThisWorkbook.Worksheets("Reference").Range("B" & i)
SKU = ThisWorkbook.Worksheets("Reference").Range("C" & i)
Name = ThisWorkbook.Worksheets("Reference").Range("D" & i)
Size = ThisWorkbook.Worksheets("Reference").Range("E" & i)
appwd.Selection.ParagraphFormat.Alignment = 1
appwd.Selection.TypeParagraph
appwd.Selection.TypeText Text:=SKU
appwd.Selection.TypeParagraph
appwd.Selection.Font.Name = "Code EAN13"
appwd.Selection.Font.Size = 40
appwd.Selection.TypeText Text:=Code
appwd.Selection.Font.Name = "Calibri"
appwd.Selection.Font.Size = 11
appwd.Selection.TypeParagraph
appwd.Selection.TypeText Text:=Name + " " + Size
SendKeys "{TAB}", False
Next i
End With
End Sub
Regards

Excel VBA IE Object and using dropdown list

I am experimenting with web automation and struggling a bit trying to utilize a drop down list.
My code works up to the point of searching for a company name and hitting "go". On the new page I can't seem to find the right code that selects the group of elements that represents the drop down list. I then want to select "100" entries, but I can't even grab the nodes that represent this list.
I have been browsing multiple different pages on stackoverflow that talk about CSS selectors and looked at tutorials but that doesn't seem to help either. I either end up grabbing nothing, or whatever I grab can't use the getElementsByTagName method, which ultimately I am trying to drill down into the td and select nodes . Not sure what to do with those yet, but I can't even grab them. Thoughts?
(note stopline is just a line that I use a breakpoint on to stop my code)
CSS helper website: https://www.w3schools.com/cssref/trysel.asp
Code:
Option Explicit
Sub test()
On Error GoTo ErrHandle
Dim ie As New InternetExplorer
Dim doc As New HTMLDocument
Dim ws As Worksheet
Dim stopLine As Integer
Dim oSearch As Object, oSearchButton As Object
Dim oForm As Object
Dim oSelect As Object
Dim list As Object
Set ws = ThisWorkbook.Worksheets("Sheet1")
ie.Visible = True
ie.navigate "https://www.sec.gov/edgar/searchedgar/companysearch.html"
Do
DoEvents
Loop Until ie.readyState = READYSTATE_COMPLETE
Set doc = ie.Document
Set oSearch = doc.getElementById("companysearchform")
Set oSearchButton = oSearch.getElementsByTagName("input")(1)
Set oSearch = oSearch.getElementsByTagName("input")(0)
oSearch.Value = "Summit Midstream Partners, LP"
oSearchButton.Click
Do
DoEvents
Loop Until ie.readyState = READYSTATE_COMPLETE
Set doc = ie.Document
Set list = doc.querySelectorAll("td select")
stopLine = 1
Exit Sub
ErrHandle:
MsgBox Err.Number & " - " & Err.Description, vbCritical
Exit Sub
End Sub
td select will return a single node so you only need querySelector. The node has an id so you might as well use the quicker querySelector("#count") to target the parent select. To change the option you can then use SelectedIndex on the parent select, or, target the child option by its value attribute querySelector("[value='100']").Selected = True. You may then need to attach and trigger change/onchange htmlevent to the parent select to register the change.
However, I would simply extract the company CIK from current page then concatenate the count=100 param into the url and .Navigate2 that using following format:
https://www.sec.gov/cgi-bin/browse-edgar?action=getcompany&CIK=0001549922&type=&dateb=&owner=include&count=100&search_text=
You can extract CIK, after initial search company click and wait for page load, with:
Dim cik As String
cik = ie.document.querySelector("[name=CIK]").value
ie.Navigate2 "https://www.sec.gov/cgi-bin/browse-edgar?action=getcompany&CIK=" & cik & "&type=&dateb=&owner=include&count=100&search_text="
Given several params are left blank you can likely shorten to:
"https://www.sec.gov/cgi-bin/browse-edgar?action=getcompany&CIK=" & cik & "&owner=include&count=100"
If you are unable to get the initial parent select you probably need a timed loop waiting for that element to be present after clicking the search button. An example is shown here in a StackOverflow answer.

Get Complete data on dropdown in web site with using macro

normally I use an excel chart to upload my data to website. but I realized that in time new additions can be added to a dropdown and unfortunately, i dont know is there anything added or not. So I want to add refresh button to my excel sheet to refresh data inside my excel and get data from website dropdown menu.
below you may find the code in web site. by the way I cannot share the link because it is behind the firewall and credentials. so here is the code
<select name="ddfener" id="ddlfener" tabindex="2" class="normalText">
<option value="0">Select a fener....</option>
<option value="81ca032h">ahmet</option>
<option value="345">mehmet</option>
<option value="123">ayse</option>
I need to download this data like
81ca032h ahmet
345 mehmet
123 ayse
thanks
You have to adjust the macro for the values read out so that they end up in the right places in your Excel table. Everything else is in the comments of the macro:
Sub ReadDropdownValues()
Dim browser As Object
Dim url As String
Dim nodeDropdown As Object
Dim nodesOption As Object
Dim optionTagNo As Long
'Only for this demo
'You write the single readed
'values to your Excel table
Dim result As String
'Place your internal url here
url = "file:///E:/testDropdown.htm"
'Initialize Internet Explorer, set visibility,
'call URL and wait until page is fully loaded
'
'This could be problematic on the intranet due to security guidelines
'Set browser = CreateObject("InternetExplorer.Application")
'
'Try this instead to initialize the IE
Set browser = GetObject("new:{D5E8041D-920F-45e9-B8FB-B1DEB82C6E5E}")
browser.Visible = False 'Set to 'True' to see the IE
browser.navigate url
Do Until browser.ReadyState = 4: DoEvents: Loop
'Get dropdown html structure
On Error Resume Next
Set nodeDropdown = browser.document.getElementByID("ddlfener")
On Error GoTo 0
'Check if object 'nodeDropdown' was build
If Not nodeDropdown Is Nothing Then
'Create node collection of option tags from object 'nodeDropdown'
Set nodesOption = nodeDropdown.getElementsByTagName("option")
'Loop through all option tags from, the second one
'(The first one is only the placeholder 'Select a fener....')
For optionTagNo = 1 To nodesOption.Length - 1
'Get the value of the attribute 'value'
result = result & Trim(nodesOption(optionTagNo).getAttribute("value"))
'Insert tab only for demo string
result = result & Chr(9)
'Get dropdown value
result = result & Trim(nodesOption(optionTagNo).innertext)
'Insert new line only for demo string
result = result & Chr(13)
Next optionTagNo
Else
'If object 'nodeDropdown' wasn't build
result = "Dropdown not found"
End If
'Clean up
browser.Quit
Set browser = Nothing
Set nodeDropdown = Nothing
Set nodesOption = Nothing
'Show demo result
MsgBox result
End Sub

How to input values into dropdown box of web page using Excel VBA

I'm trying to operate a website to display desired option chain data with an Excel VBA macro. The website -- CBOE.com -- has an input field for the ticker symbol of the desired option chains. My code has been able to drive that part of the webpage and a default option chain is displayed. It defaults to the most current month that options expire (May 2018 as of this note). From there the user can input other expiration dates for which to have other option chains (for the same symbol) to be retrieved and displayed. This is where my code seems to be breaking down.
Just above the default option chain display is a dropdown input box labeled "Expiration:" where a list of other expiration months can be selected. Once selected, a green Submit button must be clicked to get the specified option chain for the selected expiration month. Alternatively, below the default option chain are explicit filter buttons for expiration months also.
As said, my code gets to the point of specifying the symbol and getting default option chains displayed, but I can't seem to get the dropdown input field for other expiration months to work.
If anyone can see where and how my code is deficient, I'd really appreciate that insight.
Many thanks.
--Mark.
Here is my core code in question:
Sub getmarketdata_V3()
Dim mybrowser As Object, myhtml As String
Dim htmltables As Object, htmltable As Object
Dim htmlrows As Object, htmlrow As Object
Dim htmlcells As Object, htmlcell As Object
Dim xlrow As Long, xlcol As Integer
Dim exitat As Date, symbol As String
Dim flag As Integer
On Error GoTo errhdl
Const myurl = "http://www.cboe.com/delayedquote/quote-table"
symbol = UCase(Trim(Range("ticker").Text))
With Range("ticker").Worksheet
Range(Range("ticker").Offset(1, 0), Cells(Rows.Count, Range("ticker").Column + 13)).ClearContents
End With
Set mybrowser = CreateObject("internetexplorer.application")
mybrowser.Visible = True
mybrowser.navigate myurl
While mybrowser.busy Or mybrowser.readyState <> 4
DoEvents
Wend
With mybrowser.document.all
exitat = Now + TimeValue("00:00:05")
Do
.Item("ctl00$ContentTop$C002$txtSymbol").Value = symbol
.Item("ctl00$ContentTop$C002$btnSubmit").Value = "Submit"
.Item("ctl00$ContentTop$C002$btnSubmit").Click
If Err.Number = 0 Then Exit Do
Err.Clear
DoEvents
If Now > exitat Then Exit Do
Loop
End With
'This With statement is to refresh the mybrowser.document since the prior With statement pulls up a partially new webpage
With mybrowser.document.all
On Error Resume Next
exitat = Now + TimeValue("00:00:05")
'Tried using "ID" label to select desired month--in this case 2018 July is a dropdown option:
'Usind this label seems to blank out the value displayed in the dropdown input box, but does not cause
'any of the options to display nor implant "2018 July" in it either. It just remains blank and no new option
'chain is retrieved.
.Item("ContentTop_C002_ddlMonth").Select
.Item("ContentTop_C002_ddlMonth").Value = "2018 July"
.Item("ContentTop_C002_ddlMonth").Click
'Then tried using "Name" label to select desired month--in this case 2018 July is an option:
' .Item("ctl00$ContentTop$C002$ddlMonth").Value = "2018 July"
' .Item("ctl00$ContentTop$C002$ddlMonth").Click
' .Item("ctl00$ContentTop$C002$btnFilter").Value = "View Chain"
' .Item("ctl00$ContentTop$C002$btnFilter").Click
End With
While mybrowser.busy Or mybrowser.readyState <> 4
DoEvents
Wend
'Remaining logic, except for this error trap logic deals with the option chain results once it has been successfully retrieved.
'For purposes of focus on the issue of not being able to successfully have such a table displayed, that remaining process logic is not
'included here.
errhdl:
If Err.Number Then MsgBox Err.Description, vbCritical, "Get data"
On Error Resume Next
mybrowser.Quit
Set mybrowser = Nothing
Set htmltables = Nothing
End Sub
For your code:
These 2 lines change the month and click the view chain (I tested with symbol FLWS). Make sure you have sufficient delays for page to actually have loaded.
mybrowser.document.querySelector("#ContentTop_C002_ddlMonth").Value = "201809"
mybrowser.document.querySelector("#ContentTop_C002_btnFilter").Click
I found the above sketchy for timings when added into your code so I had a quick play with Selenium basic as well. Here is an example with selenium:
Option Explicit
'Tools > references > selenium type library
Public Sub GetMarketData()
Const URL As String = "http://www.cboe.com/delayedquote/quote-table"
Dim d As ChromeDriver, symbol As String
symbol = "FLWS"
Set d = New ChromeDriver
With d
.Start
.Get URL
Dim b As Object, c As Object, keys As New keys
Set b = .FindElementById("ContentTop_C002_txtSymbol")
b.SendKeys symbol
.FindElementById("ContentTop_C002_btnSubmit").Click
Set c = .FindElementById("ContentTop_C002_ddlMonth")
c.Click
c.SendKeys keys.Down 'move one month down
.FindElementById("ContentTop_C002_btnFilter").Click
Stop '<<delete me later
.Quit
End With
End Sub
Try the below approach, in case you wanna stick to IE. I tried to kick out hardcoded delay from the script. It should get you there. Make sure to fill in the text field with the appropriate ticker from the below script before execution.
There you go:
Sub HandleDropDown()
Const url As String = "http://www.cboe.com/delayedquote/quote-table"
Dim IE As New InternetExplorer, Html As HTMLDocument, post As Object, elem As Object
With IE
.Visible = True
.navigate url
While .Busy Or .readyState <> 4: DoEvents: Wend
Set Html = .document
End With
Do: Set post = Html.getElementById("ContentTop_C002_txtSymbol"): DoEvents: Loop While post Is Nothing
post.Value = "tickername" ''make sure to fill in this box with appropriate symbol
Html.getElementById("ContentTop_C002_btnSubmit").Click
Do: Set elem = Html.getElementById("ContentTop_C002_ddlMonth"): DoEvents: Loop While elem Is Nothing
elem.selectedIndex = 2 ''just select the month using it's dropdown order
Html.getElementById("ContentTop_C002_btnFilter").Click
End Sub
Reference to add to the library:
Microsoft Internet Controls
Microsoft HTML Object Library

Insert reference to page number in Microsoft Publisher 2010

I am new to MS Publisher 2010, and I am trying to add a "dynamic" reference to a specific page. Ideally, the visualized text should be something like:
...see the example on page XXX
I would like to make the XXX part visualize the page number of the page I am referring to. I saw that you can place bookmarks in the document, and create hyperlinks to those bookmarks, but so far I could not manage to visualize the page number tied to a bookmark.
To make another example, I would like the equivalent of this Latex expression:
...see the example on page~\pageref{reference-to-XXX}
Would it be possible to obtain this effect in Publisher 2010, maybe using a VB script? Thank you for your help!
http://answers.microsoft.com/en-us/office/forum/office_2007-office_other/how-do-i-hyperlink-specific-text-within-the-same/598cfd98-6217-4eac-9ac9-969477c46401?auth=1
"This is fairly easy with Pub 2007. Just Insert > bookmark and drag that icon to where you want the link to go. Then select the text >insert hyperlink > place in this document and choose the bookmark that you just created. The only time I have had problems is if the page is not long enough below the bookmark...and there are workarounds.
http://office.microsoft.com/en-us/publisher-help/create-a-hyperlink-HP010203490.aspx
DavidF"
Let me know if this helps or if you for some reason need to do it in VBA
Edit:
It is fairly easy to write a macro to refresh links to pages, but links to bookmarks seem to be poorly supported by the object model, unless I've overlooked something. My solution consists of two parts.
First of all, links that should be refreshed are recognised by their display text starting with "page " (LIKE "page *"). The refresh macro simply recognizes those links and changes their display text to page X. However, this doesn't work for links to bookmarks, which in the object model seem to behave like links to pages, except the pageID they refer to does not exist. I spent quite a while trying to figure out what the relationship might be between this non-existent hyperlink and the bookmark, but to no avail. Instead I've created a workaround in which you manually link the hyperlink and the bookmark with a tag object (creating a tag for the bookmark with the value of the non-existent page ID of the hyperlink).
Instructions for normal links to pages
Create a hyperlink to a page. The text of it must begin with ”page ”
(otherwise RefreshReferenceLinks must be edited)
Run C_RefreshReferenceLinks to refresh to check that it worked
Instructions for links to bookmarks (tagging workaround)
Create a bookmark (Insert -> Bookmark)
Create a hyperlink to the Bookmark
Select the hyperlink and run A_GetPageIdOfHyperlink
Select the bookmark and run B_TagBookmarkWithPageId
Run C_RefreshReferenceLinks to refresh to check that it worked
You can download my example project containing example content, instructions, and the macros below here: http://www.filedropper.com/showdownload.php/pageandbookmarklinks (it will probably give you a security warning because it contains macros)
Full source
Public Const tagName = "BookmarkPageId"
Sub A_GetPageIdOfHyperlink()
Dim oHyperlink As Hyperlink
Set oHyperlink = ActiveDocument.Selection.TextRange.Hyperlinks(1)
CopyText oHyperlink.pageId
MsgBox oHyperlink.pageId & " copied to clipboard as text"
End Sub
Sub B_TagBookmarkWithPageId()
Dim oShape As Shape
Set oShape = ActiveDocument.Selection.ShapeRange(1)
If IsBookmark(oShape) Then
If TagExists(oShape.Tags, tagName) Then
oShape.Tags(tagName).Delete
End If
Dim txt As String
txt = Trim(GetClipBoardText())
Debug.Print "Ssdsd:" & txt
Dim newTag As Tag
Set newTag = oShape.Tags.Add(tagName, txt)
MsgBox "Tagged as " & tagName & " = '" & txt & "'"
Else
MsgBox "Not a bookmark"
End If
End Sub
Sub C_RefreshReferenceLinks()
Dim oPage As Page
Dim oShape As Shape
For Each oPage In ActiveDocument.Pages
For Each oShape In oPage.Shapes
RefreshInShape oShape
Next oShape
Next oPage
For Each oPage In ActiveDocument.MasterPages
For Each oShape In oPage.Shapes
RefreshInShape oShape
Next oShape
Next oPage
For Each oShape In ActiveDocument.ScratchArea.Shapes
RefreshInShape oShape
Next oShape
End Sub
Function RefreshInShape(oShape As Shape)
Dim cHyperlinks As Hyperlinks
Dim oHyperlink As Hyperlink
If oShape.HasTextFrame = False Then Exit Function
Set cHyperlinks = oShape.TextFrame.TextRange.Hyperlinks
For i = 1 To cHyperlinks.Count
Set oHyperlink = cHyperlinks(i)
If oHyperlink.TargetType = pbHlinkTargetTypePageID Then
If oHyperlink.TextToDisplay Like "page *" Then
oHyperlink.TextToDisplay = "page " & GetPageNumberByPageId(oHyperlink.pageId)
End If
End If
Next i
End Function
Function GetPageNumberByPageId(pageId)
Dim oPage As Page
Dim oShape As Shape
Dim oTag As Tag
For Each oPage In ActiveDocument.Pages
If CLng(oPage.pageId) = CLng(pageId) Then
GetPageNumberByPageId = oPage.PageNumber
Exit Function
End If
Next oPage
For Each oPage In ActiveDocument.Pages
For Each oShape In oPage.Shapes
If TagExists(oShape.Tags, tagName) Then
Set oTag = oShape.Tags(tagName)
If CStr(oTag.Value) = CStr(pageId) Then
GetPageNumberByPageId = oPage.PageNumber
Exit Function
End If
End If
Next oShape
Next oPage
GetPageNumberByPageId = "[ERROR]"
End Function
Function IsBookmark(oShape As Shape)
IsBookmark = False
If oShape.Type = pbWebHTMLFragment And oShape.AutoShapeType = msoShapeMixed Then
IsBookmark = True
End If
End Function
Function TagExists(collection As Tags, itemName As String) As Boolean
TagExists = False
Dim oTag As Tag
For Each oTag In collection
If oTag.Name = itemName Then
TagExists = True
Exit For
End If
Next oTag
End Function
Function GetParentOfType(obj As Object, sTypeName As String)
Do Until TypeName(GetParentOfType) = "Page"
Set GetParentOfType = obj.Parent
Loop
End Function
Sub CopyText(Text As String)
'VBA Macro using late binding to copy text to clipboard.
'By Justin Kay, 8/15/2014
'Thanks to http://akihitoyamashiro.com/en/VBA/LateBindingDataObject.htm
Set MSForms_DataObject = CreateObject("new:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}")
MSForms_DataObject.SetText Text
MSForms_DataObject.PutInClipboard
Set MSForms_DataObject = Nothing
End Sub
Function GetClipBoardText() As String
Set DataObj = CreateObject("new:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}")
On Error GoTo Whoa
'~~> Get data from the clipboard.
DataObj.GetFromClipboard
'~~> Get clipboard contents
GetClipBoardText = DataObj.GetText(1)
Exit Function
Whoa:
GetClipBoardText = ""
End Function

Resources