[xpost][/xpost]
Please post links to all your cross-posts, in line with forum rules.
Why? Read https://www.excelguru.ca/content.php?184
[xpost][/xpost]
Please post links to all your cross-posts, in line with forum rules.
Why? Read https://www.excelguru.ca/content.php?184
Hi Claudiu,
Very pleased that the code works for you, and appreciate your kind comments.
Liking my posts is the only way other people can increase my points. The Points calculation doesn't make sense to me!
Here is a new UIAutomation function, UIAutomation_Click_IE_Tab_By_URL, which activates the tab with the specified LocationURL. It finds the required tab by activating each tab in turn and extracting the URL from the IE address bar and comparing it to the required URL - which can contain wildcards, since the Like operator is used - until the required tab is activated.
Here is the complete code, including a test routine and a function which loops through all IE windows and tabs until the required LocationURL is found.
'References required:
'Microsoft Internet Controls
'Microsoft Shell Controls and Automation
'UIAutomationClient
Option Explicit
#If VBA7 Then
Private Declare PtrSafe Sub Sleep Lib "kernel32.dll" (ByVal dwMilliseconds As LongPtr)
#Else
Private Declare Sub Sleep Lib "kernel32.dll" (ByVal dwMilliseconds As Long)
#End If
Public Sub Test_IE_UIAutomation()
Dim IE As InternetExplorer
Set IE = Find_and_Activate_IE_Tab_By_URL("*ozgrid.com*")
If Not IE Is Nothing Then
Debug.Print "Activated IE tab"
Debug.Print "LocationURL = "; IE.LocationURL
Debug.Print "LocationName = "; IE.LocationName
Else
Debug.Print "Not activated IE tab"
End If
End Sub
Private Function Find_and_Activate_IE_Tab_By_URL(findUrlLike As String) As InternetExplorer
'Look for an IE browser window or tab which matches the specified URL (Like operator wildcards allowed).
'If found, activate that IE tab and return it as an InternetExplorer object. Otherwise return Nothing.
'Works with multiple IE windows
Dim Shell As Shell
Dim IE As InternetExplorer
Dim i As Variant 'must be a variant to access items in Shell.Windows() array
Dim tabURL As String
Set Shell = New Shell
i = 0
Set Find_and_Activate_IE_Tab_By_URL = Nothing
While i < Shell.Windows.Count And Find_and_Activate_IE_Tab_By_URL Is Nothing
Set IE = Shell.Windows(i)
If Not IE Is Nothing Then
If TypeName(IE.Document) = "HTMLDocument" Then
If LCase(IE.LocationURL) Like LCase(findUrlLike) Then
'Found a tab or window which matches the specified URL, now activate it
tabURL = UIAutomation_Click_IE_Tab_By_URL(IE.hwnd, findUrlLike)
If tabURL <> "" Then Set Find_and_Activate_IE_Tab_By_URL = IE
End If
End If
End If
i = i + 1
Wend
End Function
'Find and click (activate) a tab by its URL (can contain wildcards) and return its full URL from the IE address bar
#If VBA7 Then
Private Function UIAutomation_Click_IE_Tab_By_URL(IEhwnd As LongPtr, findUrlLike As String) As String
#Else
Private Function UIAutomation_Click_IE_Tab_By_URL(IEhwnd As Long, findUrlLike As String) As String
#End If
Dim UIauto As IUIAutomation
Dim IEwindow As IUIAutomationElement, IEtab As IUIAutomationElement
Dim IEtabs As IUIAutomationElementArray
Dim tabItemCondition As IUIAutomationCondition
Dim addressBarCondition As IUIAutomationCondition
Dim IEtabPattern As IUIAutomationLegacyIAccessiblePattern
Dim IEaddressBar As IUIAutomationElement
Dim i As Long
Dim IEaddressBarUrl As String, prevIEaddressBarUrl As String
'Create UIAutomation object
Set UIauto = New CUIAutomation
'Get Internet Explorer UIAutomation element
Set IEwindow = UIauto.ElementFromHandle(ByVal IEhwnd)
IEwindow.SetFocus 'optional - brings the IE window to the foreground
'Create condition to find a TabItemControl
Set tabItemCondition = UIauto.CreatePropertyCondition(UIA_ControlTypePropertyId, UIA_TabItemControlTypeId)
'Find all tabs
Set IEtabs = IEwindow.FindAll(TreeScope_Descendants, tabItemCondition)
'Create condition to find the IE address bar. This is a control with class name "AddressDisplay Control"
Set addressBarCondition = UIauto.CreatePropertyCondition(UIA_ClassNamePropertyId, "AddressDisplay Control")
'Activate each tab until the one with the specified URL is found
UIAutomation_Click_IE_Tab_By_URL = ""
prevIEaddressBarUrl = ""
i = 0
While i < IEtabs.Length And UIAutomation_Click_IE_Tab_By_URL = ""
'Find the IE address bar
Set IEaddressBar = IEwindow.FindFirst(TreeScope_Descendants, addressBarCondition)
'Get URL from address bar
IEaddressBarUrl = IEaddressBar.GetCurrentPropertyValue(UIA_LegacyIAccessibleValuePropertyId)
'Is this the required URL?
If Not LCase(IEaddressBarUrl) Like LCase(findUrlLike) Then
'No, so activate the next tab by invoking its DoDefaultAction method (Click)
Set IEtab = IEtabs.GetElement(i)
Set IEtabPattern = IEtab.GetCurrentPattern(UIA_LegacyIAccessiblePatternId)
IEtabPattern.DoDefaultAction
DoEvents
'Wait until the tab is activated, indicated by the URL being different to the previous URL
Do
Set IEaddressBar = IEwindow.FindFirst(TreeScope_Descendants, addressBarCondition)
IEaddressBarUrl = IEaddressBar.GetCurrentPropertyValue(UIA_LegacyIAccessibleValuePropertyId)
DoEvents
Sleep 20
Loop Until IEaddressBarUrl <> prevIEaddressBarUrl
prevIEaddressBarUrl = IEaddressBarUrl
Else
'Yes, so return the full URL
UIAutomation_Click_IE_Tab_By_URL = IEaddressBarUrl
End If
i = i + 1
Wend
End Function
Display More
The error occurs at the yellow highlighted line because the IEtab object is Nothing. And IEtab is Nothing because there is no tab (a TabItemControl) with the name of your URL. The tab name of each tab in IE's UIAutomation elements is the LocationName, not the LocationURL.
Here is a detailed description of how the code works:
The main function, Find_and_Activate_IE_Tab, looks for the required tab by its LocationName or LocationURL. If found, it calls UIAutomation_Click_IE_Tab with the found LocationName and looks for the IE UI element with the specified tab name (a TabItemControl) and clicks (activates) that tab.
The 2nd argument to UIAutomation_Click_IE_Tab must be the LocationName of the tab to be activated, not the LocationURL. The reason is that, amongst all IE's UIAutomation elements, the UI element containing the LocationURL is that of the already active tab in IE's address bar - it is a UI element with the class name "AddressDisplay Control". Although the URL of a tab is displayed when you hover over that tab, I have not seen this URL anywhere in IE's UIAutomation elements, so I don't think the code could be changed to look for the URL.
You have to call Find_and_Activate_IE_Tab, which looks for the tab by its (partial) LocationURL or LocationName by looping through Shell.Windows. If found, it then calls UIAutomation_Click_IE_Tab to activate the tab. Find_and_Activate_IE_Tab uses the Like operator to look for the matching LocationURL or LocationName string, allowing wildcards in the TitleOrURL argument.
This works for me:
Public Sub Test()
Dim IE As InternetExplorer
Set IE = Find_and_Activate_IE_Tab("https://www.ozgrid.com/")
If Not IE Is Nothing Then
MsgBox "Found IE tab" & vbNewLine & _
"LocationURL = " & IE.LocationURL & vbNewLine & _
"LocationName = " & IE.LocationName
Else
MsgBox "Not found IE tab"
End If
End Sub
Display More
Try this macro:
Public Sub Import_Csv_Rows()
Dim csvFile As Variant
Dim lines As Variant, cols As Variant
Dim n As Long, i As Long, c As Long
csvFile = Application.GetOpenFilename("CSV Files (*.csv), *.csv", , "Select csv file")
If csvFile = False Then Exit Sub
lines = Split(CreateObject("Scripting.FileSystemObject").OpenTextFile(csvFile, 1).ReadAll, vbCrLf)
cols = Split(lines(0), ",")
ReDim dataArray(0 To UBound(lines), 0 To UBound(cols))
n = 0
For i = 0 To UBound(lines) - 1
cols = Split(lines(i), ",")
If cols(1) <> 0 Or cols(2) <> 0 Or cols(3) <> 0 Then
For c = 0 To UBound(cols)
dataArray(n, c) = cols(c)
Next
n = n + 1
End If
Next
ActiveSheet.Cells.Clear
ActiveSheet.Range("A1").Resize(n, UBound(dataArray, 2) + 1).Value = dataArray
End Sub
Display More
Payment received, thank you.
Here is the macro, which includes code to reuse an existing IE window, so it doesn't open a new IE browser every time it's run.
Public Sub Extract_Data_Rows()
Dim URL As String
Dim IE As Object
Dim HTMLdoc As Object
Dim mainDiv As Object
Dim oddsTable As Object
Dim r As Long
Dim v1 As String, v2 As String, v3 As String, v4 As String, v5 As String, v6 As String, v7 As String
URL = "https://www.btfodds.com/soccer/football-odds/display-odds,portugal,next-7days,average,UO"
Set IE = Get_IE_Window(URL)
If IE Is Nothing Then
Set IE = CreateObject("InternetExplorer.Application")
End If
With IE
.Visible = True
.Navigate URL
While .Busy Or .readyState <> 4: DoEvents: Wend
Set HTMLdoc = .Document
End With
Set mainDiv = HTMLdoc.getElementById("main_content")
Do
Set oddsTable = mainDiv.getElementsByTagName("TABLE")(0)
DoEvents
Loop While oddsTable Is Nothing
For r = 2 To oddsTable.Rows.Length - 1
v1 = oddsTable.Rows(r).Cells(0).innerText
v2 = oddsTable.Rows(r).Cells(1).innerText
v3 = oddsTable.Rows(r).Cells(2).innerText
v4 = oddsTable.Rows(r).Cells(3).innerText
v5 = oddsTable.Rows(r).Cells(4).innerText
v6 = oddsTable.Rows(r).Cells(5).innerText
v7 = oddsTable.Rows(r).Cells(6).innerText
'----- Put your code to handle the v1-v7 variables here -----
Debug.Print "------- Row " & r - 1 & " -------"
Debug.Print "v1=" & v1
Debug.Print "v2=" & v2
Debug.Print "v3=" & v3
Debug.Print "v4=" & v4
Debug.Print "v5=" & v5
Debug.Print "v6=" & v6
Debug.Print "v7=" & v7
Next
End Sub
Private Function Get_IE_Window(URLorName As String) As Object
'Look for an IE browser window or tab already open at the (partial or whole) URL or location name and, if found, return
'that browser as an InternetExplorer object. Otherwise return Nothing
Dim Shell As Object
Dim IE As Object
Dim i As Variant 'Must be a Variant to index Shell.Windows.Item() array
Set Shell = CreateObject("Shell.Application")
i = 0
Set Get_IE_Window = Nothing
While i < Shell.Windows.Count And Get_IE_Window Is Nothing
Set IE = Shell.Windows.Item(i)
If Not IE Is Nothing Then
If IE.Name = "Internet Explorer" And InStr(IE.LocationURL, "file://") <> 1 Then
If InStr(1, IE.LocationURL, URLorName, vbTextCompare) > 0 Or InStr(1, IE.LocationName, URLorName, vbTextCompare) > 0 Then
Set Get_IE_Window = IE
End If
End If
End If
i = i + 1
Wend
End Function
Display More
The code is ready. I will send my payment details and post it here on receipt of payment. Thanks.
I can look at this for you. I can post the code here or PM you the macro workbook - which do you prefer?
Try this:
Sub SaveAsHtmlAndClose2()
'
' SaveAsHtmlAndClose Macro
' Save as an html file, and close, with option to always update html file upon saving main xlsx file.
'
Dim p As Long
With ActiveWorkbook
p = InStrRev(.FullName, ".")
With .PublishObjects.Add(xlSourceSheet, Left(.FullName, p - 1) & ".htm", "Sheet1", "", xlHtmlStatic, "DB10_19990", "")
.Publish (True)
.AutoRepublish = True
End With
.Save
.Close
End With
End Sub
Display More
Payment received, thanks.
I've just realised that 'new destination folder' in your OP might mean that the destination folder doesn't exist. Simply add this line below the ... Set FSO = ... line:
and it will create the last folder in the destination folder path, if it doesn't already exist.
Let me know if you require any other changes after testing.
Here is your workbook with the Copy_Files macro added.
[ATTACH]n1219310[/ATTACH]
The search folder and destination folder are named ranges, referenced in the code.
Column B shows whether the file was copied or not found.
I will send my Paypal details for payment in a PM.
Thanks,
I can look at this for you. Can you upload a sample workbook please.
The trouble with referencing multiple elements in one line, as your For Each line does, is that you can't tell which part is failing. (The error is probably caused by getElementbyClassName - it should be getElementsByClassName.)
Try this for the first four items - the others should be similar. Add a reference to MS HTML Object Library.
Dim HTMLdoc As HTMLdocument
Set HTMLdoc = objIE.document
MsgBox HTMLdoc.getElementsByClassName("headerDetails")(0).innerText 'assuming it's in the first element with class 'headerDetails'
MsgBox HTMLdoc.getElementsByClassName("headerDetailsValues")(0).innerText 'ditto 'headerDetailsValues'
Dim v As Variant
v = Split(HTMLdoc.getElementsByClassName("reportTitle2")(0).innerText,vbCrLf)
MsgBox v(0) & " " v(1)
MsgBox HTMLdoc.getElementsByName("Target_Buy_Date")(0).value
Display More
It sounds like you could use the same class. But if my guess (you don't say exactly) that the idea with
Is to prevent the user typing in or changing the txtbx2 field, why don't you set txtbx2 to read only at run-time by setting its Locked property to True:
With newTextbox
.Name = "txtbx" & i
.Top = y + 20
.Height = 18
.Left = x
.Width = 120
.Font.Size = "10"
.Font.Name = "Calibri"
If .Name = "txtbx2" Then .Locked = True
End With
But without knowing what you are trying to do I can only guess.
Stick to this thread if any questions or issues are related to this specific task, otherwise please start a new thread.
See if this macro does steps 1 to 4, as required. Rather than opening each selected .csv file, it uses a text query to import the data into the macro workbook. The first .csv file import starts at row 1, to include column headings, and subsequent files start at row 2 to omit them. I put comments in the code to help you to understand it.
Public Sub Copy_and_Import_Selected_CSV_Files()
Dim destinationFolder As String
Dim destinationCell As Range
Dim startRow As Long
Dim FD As FileDialog
Dim csvFile As Variant
'Set destination folder where .csv files will be copied - a new Desktop subfolder
destinationFolder = CreateObject("WScript.Shell").SpecialFolders("Desktop") & "\Matches " & Format(Now, "DD-MMM-YYYY hh mm ss\")
If Right(destinationFolder, 1) <> "\" Then destinationFolder = destinationFolder & "\"
If Dir(destinationFolder, vbDirectory) = vbNullString Then MkDir destinationFolder
'Set destination cell where first .csv file will be imported - A1 in first sheet in this workbook
With ThisWorkbook.Worksheets(1)
.Cells.Clear
Set destinationCell = .Range("A1")
End With
startRow = 1
'Select multiple .csv files
Set FD = Application.FileDialog(msoFileDialogOpen)
With FD
.AllowMultiSelect = True
.Title = "Multi-select target data files:"
.ButtonName = ""
.Filters.Clear
.Filters.Add ".csv files", "*.csv"
If Not .Show Then Exit Sub
End With
'For each .csv file, copy it to destination folder and import data
For Each csvFile In FD.SelectedItems
'Copy .csv file to destination folder
FileCopy csvFile, destinationFolder & Mid(csvFile, InStrRev(csvFile, "\") + 1)
'Import csv data to current destination cell
With destinationCell.Worksheet.QueryTables.Add(Connection:="TEXT;" & csvFile, Destination:=destinationCell)
.TextFileStartRow = startRow
.TextFileCommaDelimiter = True
.Refresh BackgroundQuery:=False
Set destinationCell = destinationCell.Offset(.ResultRange.Rows.Count, 0)
.Delete
End With
'Import next csv data from row 2
startRow = 2
Next
'Save destination sheet as Matches.csv in destination folder
destinationCell.Worksheet.Copy
ActiveWorkbook.SaveAs Filename:=destinationFolder & "Matches.csv", FileFormat:=xlCSV
ActiveWorkbook.Close False
'Clear destination sheet in this workbook
destinationCell.Worksheet.Cells.Clear
'Open Matches.csv
Workbooks.Open Filename:=destinationFolder & "Matches.csv"
MsgBox "Finished"
End Sub
Display More
Put this above the Next i:
[VBA] Set clsObject = New clsObjHandler
Set clsObject.Control = newTextbox
colTbxs.Add clsObject[/VBA]
Then delete the entire For Each ... Next loop.
You don't seem to have copied the code correctly. In clsObjHandler you need:
[VBA]Public Property Set Control(tbxNew As MSForms.TextBox)
Set tbxCustom1 = tbxNew
End Property
[/VBA]And in the For Each loop (whose innards you could incorporate into the For i loop, rather than separate loops) change:
[VBA]Set clsObject.tbxCustomEvent = ctlLoop
[/VBA]to:
[VBA]Set clsObject.Control = ctlLoop[/VBA]Then checking the textbox name inside the Keypress event should be:
[VBA]If tbxCustom1.Name = "txtbx2" Then[/VBA]Also, you could declare colTbxs outside the procedures so you can clear it in the UserForm_Terminate event, as shown in the linked code.
Try incorporating https://www.ozgrid.com/forum/f…9869-textbox-class-object into your code. In tbxCustom1_KeyPress, tbxCustom1.Name should be the name of the current TextBox control.