How do I write extract values in Edge using VBA

300 Views Asked by At

I have a worksheet with values in column A that I want to look up on a password protected website.

I am trying to write VBA code to achieve the following in order:

  1. Open MS Edge
  2. Enter my username and password
  3. Cycle through parts of a page to find my desired field.
  4. Populate this field with value "A1" from my worksheet and enter.
  5. Cycle through the returned page to find my chosen value.
  6. Copy this value
  7. Paste this value to "B1" in the worksheet
  8. Repeat for all values in column A

I am using a corporate system so cannot utilise addons like Selenium

I can achieve 1 - 5 using sendkeys, and whilst the script doesn't error, cell B1 is not populated. I haven't even tried to write the Integer add on to loop - as am already losing the will to live.

I'm conscious that sendkeys is a horrible solution, but I cannot force the site to use Explorer.

I would welcome any suggestions. I'm conscious that the pasted target value should be identified as a string, but don't know how to combine that with the paste command.

Here is my horrible sendkeys code:

Sub OpenEdgeAndLogin()
                    
Dim objShell As Object
Set objShell = CreateObject("WScript.Shell")
Dim cellValue As String
Dim cellAddress As String
cellAddress = "A1"
cellValue = Range(cellAddress).Value
                        
                        
'Open Microsoft Edge
objShell.Run "microsoft-edge:xxxxxxxxxxxxxxxxxx"                            
'Wait for Edge to load
Application.Wait (Now + TimeValue("0:00:02"))                            
'Enter user ID
objShell.SendKeys "xxxx"                            
'Press tab to move to password field
objShell.SendKeys "{TAB}"                            
'Enter password
objShell.SendKeys "xxxxxxxxxx"                            
'objShell.SendKeys "{TAB 2}"                            
'Application.Wait (Now + TimeValue("0:00:03"))                            
'Press enter to submit
objShell.SendKeys "{ENTER}"                             
Application.Wait (Now + TimeValue("0:00:03"))                             
objShell.SendKeys "{TAB 4}"                             
objShell.SendKeys "{ENTER}"                             
Application.Wait (Now + TimeValue("0:00:02"))                         
                        
SendKeys cellValue, True                             
objShell.SendKeys "{ENTER}"                             
Application.Wait (Now + TimeValue("0:00:02"))                             
objShell.SendKeys "{TAB 1}"                             
objShell.SendKeys "{ENTER}"                             
Application.Wait (Now + TimeValue("0:00:01"))
                         
objShell.SendKeys "{TAB 6}"                           

                                                     
objShell.SendKeys ("^c"), True                             
Range("B1").Select                             
SendKeys ("^v"), True                            
                         
                         
End Sub
0

There are 0 best solutions below