PDA

View Full Version : Get current web page title and output to cell



meatbag
06-17-2013, 04:09 PM
Sup fellas, need a bit of help with the above if possible.
Basically I need help writing some vba code to pull the current web page title from IE and for it to output to a cell of my choosing, i.e C3.

I also need to know if it would be possible to input only part of the title and not all of it, for example if the page title reads "VBA 12345", I would like the option of just outputting to my cell "12345" ignoring the "VBA" part.

The reason I ask this is that I have a system which uses alot of account numbers, the system is IE based, and everytime I access an account the page title would change reflecting that account, so would be ideal if i could click a button that outputs the current account i'm looking at.

The other issue is that I could have multiple IE windows at any given time, is there anyway I can choose a specific one to pull the data from?

Many thanks.

Jan Karel Pieterse
06-18-2013, 08:47 AM
This runs youthrough all windows that have "Internet" in their title:

Option Explicit
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Copyright ©1996-2000 VBnet, Randy Birch, All Rights Reserved.
' Some pages may also contain other copyrights by the author.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' You are free to use this code within your own applications,
' but you are expressly forbidden from selling or otherwise
' distributing this source code without prior written consent.
' This includes both posting free demo projects made from this
' code as well as reproducing the code in text or html format.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
#If VBA7 Then
Public Declare PtrSafe Function GetDesktopWindow Lib "USER32" () As LongPtr

Public Declare PtrSafe Function GetWindow Lib "USER32" _
(ByVal hWnd As LongPtr, ByVal wCmd As LongPtr) As LongPtr

Public Declare PtrSafe Function GetWindowText Lib "USER32" Alias "GetWindowTextA" _
(ByVal hWnd As LongPtr, ByVal lpString As String, _
ByVal cch As LongPtr) As Long

Public Declare PtrSafe Function GetClassName Lib "USER32" Alias "GetClassNameA" _
(ByVal hWnd As LongPtr, ByVal lpClassName As String, _
ByVal nMaxCount As LongPtr) As Long
#Else
Public Declare Function GetDesktopWindow Lib "USER32" () As Long

Public Declare Function GetWindow Lib "USER32" _
(ByVal hWnd As Long, ByVal wCmd As Long) As Long

Public Declare Function GetWindowText Lib "USER32" Alias "GetWindowTextA" _
(ByVal hWnd As Long, ByVal lpString As String, _
ByVal cch As Long) As Long

Public Declare Function GetClassName Lib "USER32" Alias "GetClassNameA" _
(ByVal hWnd As Long, ByVal lpClassName As String, _
ByVal nMaxCount As Long) As Long
#End If
Public Const GW_HWNDFIRST = 0
Public Const GW_HWNDLAST = 1
Public Const GW_HWNDNEXT = 2
Public Const GW_HWNDPREV = 3
Public Const GW_OWNER = 4
Public Const GW_CHILD = 5
Dim iCount As Integer
Public Sub EnumerateWindows()
Dim cCol As Collection
On Error GoTo LocErr
Set cCol = New Collection
iCount = 0
'Used to return window handles.
Dim TitleToFind As String, ClassToFind As String
TitleToFind = "*Internet*"
ClassToFind = "*"
Call FindWindowLike(0, TitleToFind, ClassToFind, cCol, True)
For iCount = 1 To cCol.Count
If MsgBox(cCol(iCount), vbYesNo) = vbYes Then
AppActivate cCol(iCount)
End If
Next
TidyUp:
Exit Sub
LocErr:
End Sub
#If VBA7 Then
Private Function FindWindowLike(ByVal hWndStart As LongPtr, WindowText As String, Classname As String, _
cCol As Collection, Optional bRestart As Boolean = False) As LongPtr
Dim hWnd As LongPtr
#Else
Private Function FindWindowLike(ByVal hWndStart As Long, WindowText As String, Classname As String, cCol As Collection, _
Optional bRestart As Boolean = False) As Long
Dim hWnd As Long
#End If
Dim sWindowText As String
Dim sClassname As String
Dim r As Long

On Error GoTo LocErr
'Hold the level of recursion and
'hold the number of matching windows
Static level As Integer
'Initialize if necessary. This is only executed when level = 0
'and hWndStart = 0, normally only on the first call to the routine.
If level = 0 Then
If hWndStart = 0 Then hWndStart = GetDesktopWindow()
End If
'Increase recursion counter
level = level + 1
'Get first child window
hWnd = GetWindow(hWndStart, GW_CHILD)
Do Until hWnd = 0
'Search children by recursion
Call FindWindowLike(hWnd, WindowText, Classname, cCol)
'Get the window text and class name
sWindowText = Space$(255)
r = GetWindowText(hWnd, sWindowText, 255)
sWindowText = Left(sWindowText, r)
sClassname = Space$(255)
r = GetClassName(hWnd, sClassname, 255)
sClassname = Left(sClassname, r)
'Check if window found matches the search parameters
If (sWindowText Like WindowText) And (sClassname Like Classname) Then
cCol.Add sWindowText
' FindWindowLike = hWnd
'uncommenting the next line causes the routine to
'only return the first matching window.
' Exit Do
End If
'Get next child window
hWnd = GetWindow(hWnd, GW_HWNDNEXT)
Loop
'Reduce the recursion counter
level = level - 1
TidyUp:
Exit Function
LocErr:
End Function

meatbag
06-18-2013, 12:39 PM
Thanks very much for your help, I've managed to alter the code slightly so it recognises the IE window, so thats the hard bit out the way hopefully.

What am trying to do now is to get it to output to a specific cell instead of the message box:

For iCount = 1 To cCol.Count
If MsgBox(cCol(iCount), vbYesNo) = vbYes Then
AppActivate cCol(iCount)
End If
Next
TidyUp:
Exit Sub
LocErr:
End Sub

Then after this I need to know how to grab only part of the web title and not all of it, example in my OP.

Jan Karel Pieterse
06-18-2013, 10:43 PM
Replace the If...Endif with:

Activesheet.Cells(iCount,1).Value = cCols(iCount)

meatbag
06-19-2013, 09:05 AM
Thanks again for your help, that seems to have sorted it, amended it slightly so it outputs to a specific cell. My last part am trying to resolve is outputting only part of the web title and not the full thing. Is this even possible?

Jan Karel Pieterse
06-19-2013, 11:02 AM
Of course, anything goes as far as VBA is concerned. What part do you need exactly?

meatbag
06-19-2013, 02:51 PM
well when it outputs the full web page title to the cell, i would prefer it so it doesnt output the FULL title. For example if cell A1 grabs the page title of youtube, it would say "Youtube - Miscrosoft Internet Explorer" but I would like to say just "Youtube"

I found a way using the =MID formula on excel, but would prefer for VBA to do this for me and output it as clear text instead.

Jan Karel Pieterse
06-20-2013, 02:18 AM
You could use something like:



Activesheet.Cells(iCount,1).Value = Replace(cCols(iCount), " - Microsoft Internet Explorer", "")