I am working with VB6 WebBrowser, Here i need to open a vb6 form when user click any particular link of WebBrowser's link like
In HTML
<html>
<head>
<body>
Click To show VB6 Form2
</body>
</html>
I do't have any idea how to do it. I thought sometime it can be done a third text file like when the link clicked will write a cod like 002 in a text file.
And the in vb form a Timer will check once a second the file, when timer detect the file contains 002 it will show the form.
Can be do this by this method? or anything else shorter i can except?
Pick a better naming scheme like:
Click To show VB6 Form2
Waffles
Then intercept link clicks via the BeforeNavigate2 event, look at the url and if it matches #vb-* run your code:
Private Sub WebBrowserCtrl_BeforeNavigate2(ByVal pDisp As Object, URL As Variant, Flags As Variant, TargetFrameName As Variant, PostData As Variant, Headers As Variant, Cancel As Boolean)
'// get #vb-XXX command from url
Dim pos As Long: pos = InStrRev(URL, "#vb-")
If pos Then
Cancel = True '// stop default navigation
URL = Mid$(URL, pos + 4)
Select Case LCase$(URL)
Case "showform2": Form2.Show
'...
Case "waffles": MsgBox "Waffles."
Case Else: MsgBox "Unknown Command " & URL
End Select
End If
End Sub
Instead of putting the form name inside the href attribute, I believe a better method would be to set a your own data attribute and use that, it seems to me a much cleaner way to do such a task.
In my example, inside the href tag i'm using the classic void(0) to prevent the link navigation, otherwise your external link to VB forms could break the browser history with unexpected results.
To use the WebBrowser control, You should have already added in your VB project a reference to the Microsoft Internet Controls, what you need next is to add a reference to the Microsoft HTML Library, the type library contained inside the mshtml.tlb file.
Assuming your WebBrowser control is called "WebBrowser1", and you have three additional forms called "Form1", "Form2" and "Form3", in the form where you placed the WebBrowser control put this piece of code:
Private HTMLdoc As MSHTML.HTMLDocument
' Create a Web Page to test the navigation '
' You can skip this phase after your test are successfully executed '
Private Sub Form_Load()
Dim HTML As String
WebBrowser1.Navigate "about:blank"
HTML = "<html>"
HTML = HTML & "<title>Open a VB Form from a Link</title>"
HTML = HTML & "<body>"
HTML = HTML & "<a data-vb='Form1' href='javascript:void(0)'>Click To show Form1</a>"
HTML = HTML & "</br>"
HTML = HTML & "<a data-vb='Form2' href='javascript:void(0)'>Click To show Form2</a>"
HTML = HTML & "</br>"
HTML = HTML & "<a data-vb='Form3' href='javascript:void(0)'>Click To show Form3</a>"
HTML = HTML & "</br>"
HTML = HTML & "</body>"
HTML = HTML & "</html>"
WebBrowser1.Document.Write HTML
End Sub
' This will load and show the form specified in the data-vb attribute of the link '
Private Sub WebBrowser1_BeforeNavigate2(ByVal pDisp As Object, URL As Variant, Flags As Variant, TargetFrameName As Variant, PostData As Variant, Headers As Variant, Cancel As Boolean)
Dim frm As Form, FormName as String
If Not (WebBrowser1.Document Is Nothing) Then
Set HTMLdoc = WebBrowser1.Document
FormName = vbNullString & HTMLdoc.activeElement.getAttribute("data-vb")
If Not FormName = vbNullString Then
Set frm = Forms.Add(FormName)
frm.Show
End If
End If
End Sub
An additional note:
You can get the content of the clicked link in following way:
HTMLdoc.activeElement.toString
Obviously, for all links in my test page, the result will be:
javascript:void(0) which is the same as the URL parameter of the BeforeNavigate event.
Another useful information which you can get from the HTMLDocument and wouldn't be available in the BeforeNavigate event is, for example:
HTMLdoc.activeElement.outerHTML
the result will be:
Click To show Form2
To do this with a button instead of a link, add the button to the document and a bit of javascript:
<input type="button" id="MyButton1_id" style="cursor: pointer" name=MyButton1 value="Show It!">
<SCRIPT LANGUAGE="VBScript">
Sub MyButton1_OnClick()
location.href = "event:button1_show"
End Sub
</SCRIPT>
Then in the BeforeNavigate2 event:
Public Sub webBrowser_BeforeNavigate2(ByVal pDisp As Object, URL As Variant, flags As Variant, TargetFrameName As Variant, PostData As Variant, Headers As Variant, Cancel As Boolean)
Select Case LCase$(URL)
Case "event:button1_show"
Cancel = True
Form2.Show
Case "event:other_stuff"
'other stuff to do, etc
End Select
End Sub
Related
I have a problem with the VBA code.
I would like to open this website: https://www.tnt.com/express/en_us/site/tracking.html and in Shipment numbers search box I would like to put active cells from Excel file. At the beginning I tried to put only a specific text for example: "777777".
I wrote the below code but unfortunately, the search button is empty and there is no error. I tried everything and I have no idea what should I change in my code.
Any clues? Thank you in advance.
HTML:
<input class="__c-form-field__text ng-touched ng-dirty ng-invalid" formcontrolname="query" pbconvertnewlinestocommasonpaste="" pbsearchhistorynavigation="" shamselectalltextonfocus="" type="search">
VBA:
Sub TNT2_tracker()
Dim objIE As InternetExplorer
Dim aEle As HTMLLinkElement
Dim y As Integer
Dim result As String
Set objIE = New InternetExplorer
objIE.Visible = True
objIE.navigate "https://www.tnt.com/express/en_us/site/tracking.html"
Do While objIE.Busy = True Or objIE.readyState <> 4: DoEvents: Loop
Dim webpageelement As Object
For Each webpageelement In objIE.document.getElementsByClassName("input")
If webpageelement.Class = "__c-form-field__text ng-pristine ng-invalid ng-touched" Then
webpageelement.Value = "777"
End If
Next webpageelement
End Sub
You could use the querySelector + class name to find an element.
something like
'Find the input box
objIE.document.querySelector("input.__c-form-field__text").value = "test"
'Find the search button and do a click
objIE.document.querySelector("button.__c-btn").Click
No need to loop through elements. Unless the site allows you to search multiple tracking numbers at the same time.
It seems automating this page is a litte tricky. If you change the value of the input field it doesn' t work. Nothing happen by clicking the submit button.
A look in the dom inspector shows several events for the input field. I checked them out and it seems we need to paste the value over the clipboard by trigger the paste event of the shipping field.
In order for this to work without Internet Explorer prompting, its security settings for the Internet zone must be set to allow pasting from the clipboard. I'm using a German version of IE, so I have problems explaining how to find the setting.
This macro works for me:
Sub TNT2_tracker()
Dim browser As Object
Dim url As String
Dim nodeDivWithInputField As Object
Dim nodeInputShipmentNumber As Object
Dim textToClipboard As Object
'Dataobject by late binding to use the clipboard
Set textToClipboard = CreateObject("New:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}")
url = "https://www.tnt.com/express/en_us/site/tracking.html"
'Initialize Internet Explorer, set visibility,
'call URL and wait until page is fully loaded
Set browser = CreateObject("internetexplorer.application")
browser.Visible = True
browser.navigate url
Do Until browser.ReadyState = 4: DoEvents: Loop
'Manual break for loading the page complitly
'Application.Wait (Now + TimeSerial(pause_hours, pause_minutes, pause_seconds))
Application.Wait (Now + TimeSerial(0, 0, 3))
'Get div element with input field for shipment number
Set nodeDivWithInputField = browser.Document.getElementsByClassName("pb-search-form-input-group")(0)
If Not nodeDivWithInputField Is Nothing Then
'If we got the div element ...
'First child element is the input field
Set nodeInputShipmentNumber = nodeDivWithInputField.FirstChild
'Put shipment number to clipboard
textToClipboard.setText "7777777"
textToClipboard.PutInClipboard
'Insert value by trigger paste event of the input field
Call TriggerEvent(browser.Document, nodeInputShipmentNumber, "paste")
'Click button
browser.Document.getElementsByClassName("__c-btn")(0).Click
Else
MsgBox "No input field for shipment number found."
End If
End Sub
And this function to trigger a html event:
Private Sub TriggerEvent(htmlDocument As Object, htmlElementWithEvent As Object, eventType As String)
Dim theEvent As Object
htmlElementWithEvent.Focus
Set theEvent = htmlDocument.createEvent("HTMLEvents")
theEvent.initEvent eventType, True, False
htmlElementWithEvent.dispatchEvent theEvent
End Sub
As #Stavros Jon alludes to..... there is a browserless way using xhr GET request via API. It returns json and thus you ideally need to use a json parser to handle the response.
I use jsonconverter.bas as the json parser to handle the response. Download raw code from here and add to standard module called JsonConverter . You then need to go VBE > Tools > References > Add reference to Microsoft Scripting Runtime. Remove the top Attribute line from the copied code.
Example request with dummy tracking number (deliberately passed as string):
Option Explicit
Public Sub TntTracking()
Dim json As Object, ws As Worksheet, trackingNumber As String
trackingNumber = "1234567" 'test input value. Currently this is not a valid input but is for demo.
Set ws = ThisWorkbook.Worksheets("Sheet1") 'for later use if writing something specific out
With CreateObject("MSXML2.XMLHTTP")
.Open "GET", "https://www.tnt.com/api/v3/shipment?con=" & trackingNumber & "&searchType=CON&locale=en_US&channel=OPENTRACK", False
.send
Set json = JsonConverter.ParseJson(.responseText)
End With
'do something with results
Debug.Print json("tracker.output")("notFound").Count > 0
Debug.Print JsonConverter.ConvertToJson(json("tracker.output")("notFound"))
End Sub
I want to display PDF files for each separate record on my form in Access. The form is populated from a combo box's result (select a key field from combo box), and form gets populated with a large amount of info from a query.
For each unique value in the underlying table, there is a pdf file related to it. I want to use the web browser control to define the file path for each unique key. For example,
S:\FolderPath\xyz\keyvalue.pdf"
where keyvalue.pdf is literally the contents of a text box on the form that has the text field source for that record followed by a '.pdf' so if my key is 1, it will be 1.pdf, if it is A-22ds, the file will be A-22ds.pdf.
Let's say you have a form with a web browser control called MyWebbrowserControl, and you want to get the PDF in there:
Public Sub LoadPDF(MyPdfLocation As String)
Dim wb As Object
Dim strHTML As String
strHTML = "<html><head><title>My PDF</title></head><body>" & _
"<embed style=""width:100%;height:100%;"" src=""" & Application.HtmlEncode(MyPdfLocation) & """ type=""application/pdf""></embed></body></html>"
Set wb = MyWebbrowserControl.Object
With wb
.Navigate2 "about:blank"
Do Until .ReadyState = 4 '=READYSTATE_COMPLETE
'This is an inefficient way to wait, but loading a blank page should only take a couple of milliseconds
DoEvents
Loop
.Document.Open
.Document.Write strHTML
.Document.Close
End With
End Sub
(I'm using very generic HTML, it might benefit from some tweaking).
Them call it on Form_Current, for example:
Private Sub Form_Current()
Dim path As String
Dim filename As String
path = "S:\MDM\MIRS\SCOPE-MP\"
filename = Me.cboPSENumber.Value + "_MP.pdf" 'Final path should be path + filename
Me.LoadPDF path & filename
End Sub
I am a beginner of coding. I am now learning how to get information from web through Excel or VBA.
My question can be ask through below example:
In below link (https://www.schooland.hk/ss/tsuen-wan),
when you click those individual blue wordings in the red circle which I shown, it will leads to individual pages.
In all those individual pages, for example (https://www.schooland.hk/ss/twgss), they also have a part like this showing same kind of information, like phone number etc.(As circled below).
My work is to use a spreadsheet, like excel, show a table which listed all those individual wordings' informations in the red circled without using copy and paste.
How could I do it?
The following using XHR to achieve your task.
Notes:
GetSchoolInfo is the main sub.
It sends the initial request to "https://www.schooland.hk/ss/tsuen-wan" .It uses the function GetHTMLDoc to return an HTML document for the webpage URL passed in.
The links to individual schools you show in the first red circled area can be retrieved using a CSS selector of
.school-table a
"." means className, so .school-table means all elements with className school-table.
" a" means all a tags contained within that.
Sample results returned by this CSS query:
The actual HTML returned for each link is like the following:
<A title="Tsuen Wan Government Secondary School" href="about:twgss">??????</A>
We can make use of the fact that each linked to page uses the short string after about: i.e. twggs concatentated with a general base string of "https://www.schooland.hk/ss/", to give each school specific URL i.e.
"https://www.schooland.hk/ss/twggs".
Function GethRefSubString obtains this short string which is concantenated with the general base string BASEURL. This school specific link is the added to the schoolLinks collection.
The schoolLinks collection is looped using GetHTMLDoc to process the links into school specific new HTML documents.
The contact info on each school page, the second red circled area in your question, resides with an HTMLDivElement with className contact. The appropriate index is 0 i.e. the first matching className in the collection (also the only!).
All the required contact info can be accessed via the .innerText property of the HTMLDivElement.
Example webpage content:
Example code output:
VBA Code:
Option Explicit
Public Sub GetSchoolInfo()
Application.ScreenUpdating = False
Dim xmlHttp As Object, html As HTMLDocument, links As Object
Const BASEURL As String = "https://www.schooland.hk/ss/"
Set xmlHttp = CreateObject("MSXML2.XMLHTTP.6.0")
Set html = GetHTMLDoc("https://www.schooland.hk/ss/tsuen-wan", xmlHttp)
Set links = html.querySelectorAll(".school-table a[href]") 'get all
Dim link As Long, schoolLinks As Collection
Set schoolLinks = New Collection
For link = 0 To links.Length - 1
schoolLinks.Add BASEURL & GethRefSubString(links(link).outerHTML)
Next link
Dim currentLink, counter As Long
With ActiveSheet
For Each currentLink In schoolLinks
counter = counter + 1
Set html = GetHTMLDoc(currentLink, xmlHttp)
Dim contactInfo As Object '<HTMLDivElement
Set contactInfo = html.getElementsByClassName("contact")(0)
.Cells(counter, 1) = contactInfo.innerText
Next currentLink
End With
Application.ScreenUpdating = True
End Sub
Public Function GetHTMLDoc(ByVal url As String, ByRef xmlHttp As Object) As HTMLDocument
With xmlHttp
.Open "GET", url, False
.setRequestHeader "Content-Type", "text/xml"
.send
Dim html As HTMLDocument
Set html = New HTMLDocument
html.body.innerHTML = .responseText
End With
Set GetHTMLDoc = html
End Function
Public Function GethRefSubString(ByVal aString As String) As String
GethRefSubString = Split(Split(aString, "href=""about:")(1), Chr$(34))(0)
End Function
References required:
VBE > Tools > References > HTML Object library
I would like to know how can I export data from VB6 textbox to a HTML textbox? It could be a simple html page or an asp page.
for example, on my VB6 form, i have an name field. Upon clicking of a button on the VB6 form, the data in the name field will be exported to a textbox on the html page.
Thank you all for help and time for reading this.
To see this demo in action, and be able to follow it through and learn how to grab from it what you need:
Create a form with a lable over a textbox, and stick 1 command buttons on the form. Don't rename any of them - the program expects the text1, command1
The following CODE is the complete FORM CODE to copy/paste into it.
Add refernce to your project from (Project=>References)Microsoft Internet Controls,Microsoft HTML Object Library,
Option Explicit
Public TargetIE As SHDocVw.InternetExplorer
Private Sub Command1_Click() ' Send text to first IE-document found
GetTheIEObjectFromSystem
SendTextToActiveElementWithSubmitOptionSet (False)
End Sub
Private Sub Form_Load()
Me.Text1 = "This is a sample text message set and submitted programmatically" 'make text1 multiline in design
Me.Command1.Caption = "Text to the first IE browser document found"
End Sub
Public Sub GetTheIEObjectFromSystem(Optional ByVal inurl As String = ".") ' "." will be found in ALL browser URLs
Dim SWs As New SHDocVw.ShellWindows
Dim IE As SHDocVw.InternetExplorer
Dim Doc As Object
For Each IE In SWs
If TypeOf IE.Document Is HTMLDocument Then ' necessary to avoid Windows Explorer
If InStr(IE.LocationURL, inurl) > 0 Then
Set TargetIE = IE
Exit For
End If
End If
Next
Set SWs = Nothing
Set IE = Nothing
End Sub
Private Sub SendTextToActiveElementWithSubmitOptionSet(ByVal bSubmitIt As Boolean)
Dim TheActiveElement As IHTMLElement
Set TheActiveElement = TargetIE.Document.activeElement
If Not TheActiveElement.isTextEdit Then
MsgBox "Active element is not a text-input system"
Else
TheActiveElement.Value = Me.Text1.Text
Dim directParent As IHTMLElement
If bSubmitIt Then
Dim pageForm As IHTMLFormElement
Set directParent = TheActiveElement.parentElement
' find its parent FORM element by checking parent nodes up and up and up until found or BODY
Do While (UCase(directParent.tagName) <> "FORM" And UCase(directParent.tagName <> "BODY"))
Set directParent = directParent.parentElement
Loop
If UCase(directParent.tagName) = "FORM" Then
Set pageForm = directParent
pageForm.submit 'intrinsic Form-element Method
Else
MsgBox ("Error: No form unit for submitting the text on this page!")
End If
End If
Set pageForm = Nothing
Set directParent = Nothing
End If
Set TheActiveElement = Nothing
Set TargetIE = Nothing
End Sub
Code to create new form instance of a closed form using form name
I want to replace the long Select Case list with a variable.
Full code of module
In Access 2010 I have a VBA function that opens a new instance of a form when given a string containing the form's name. By adding a form variable "frm" to a collection:
mcolFormInstances.Add Item:=frm, Key:=CStr(frm.Hwnd)
The only way I can figure out to open "frm" is with a Select Case statement that I've manually entered.
Select Case strFormName
Case "frmCustomer"
Set frm = New Form_frmCustomer
Case "frmProduct"
Set frm = New Form_frmProduct
... etc ... !
End Select
I want it to do it automatically, somewhat like this (although this doesn't work):
Set frm = New Eval("Form_" & strFormName)
Or through some code:
For Each obj In CurrentProject.AllForms 'or AllModules, neither work
If obj.Name = strFormName Then
Set FormObject = obj.AccessClassObject 'or something
End If
Next
Set frm = New FormObject
I just want to avoid listing out every single form in my project and having to keep the list updated as new forms are added.
I've also done some testing of my own and some reading online about this. As near as I can tell, it isn't possible to create a new form object and set it to an instance of an existing form using a string that represents the name of that form without using DoCmd.OpenForm.
In other words, unless someone else can prove me wrong, what you are trying to do cannot be done.
I think you are looking for something like this MS-Access 2010 function. (The GetForm sub is just for testing):
Function SelectForm(ByVal FormName As String, ByRef FormExists As Boolean) As Form
For Each f In Application.Forms
If f.Name = FormName Then
Set SelectForm = f
FormExists = True
Exit Function
End If
Next
FormExists = False
End Function
Sub GetForm(ByVal FormName As String)
Dim f As New Form
Dim FormExists As Boolean
Set f = SelectForm(FormName, FormExists)
If FormExists Then
MsgBox ("Form Found: " & f.Caption)
Else
MsgBox ("Form '" & FormName & "' not found.")
End If
End Sub
Here's an ugly hack I found:
DoCmd.SelectObject <acObjectType>, <YourObjectsName>, True
DoCmd.RunCommand acCmdNewObjectForm
The RunCommand step doesn't give you programmatic control of the object, you'll have to Dim a Form variable and Set using Forms.Item(). I usually close the form after DoCmd.RunCommand, then DoCmd.Rename with something useful (my users don't like Form1, Form2, etc.).
Hope that helps.