Open secure website and paste username and password.

[schafers]

Trying to find a set of code that I can use to open a website that's predetermined, and enter in the users name and password automatically. And if possible, open a new email via the website, addressed to a person, and ready to browse for the file to attach.

The code I have is below.

Private Sub CommandButton1_Click()
'
storenumber = [$c$3]

If [$iv$2] = True Then

If [$iv$3] <> 0 Then

MsgBox ("Can't send with No Adjustments Checked & Items to Adjust, Please clear one")

End
End If
End If

If [$iv$2] = False Then

If [$iv$3] = 0 Then

MsgBox ("Can't send without No Adjustments checked or Items to Adjust")

End
End If
End If

If MsgBox( _
prompt:="Ready to Send Adjustments?", _
Title:="Proceed?", _
Buttons:=vbYesNo) = vbYes Then
Application.ScreenUpdating = False
ActiveSheet.Copy
ActiveSheet.Shapes("CommandButton1").Select
Selection.Delete
Application.DisplayAlerts = False
ActiveWorkbook.SaveAs "Store #" & storenumber & " - SEND THIS FILE" & " To Cathy" & ".xls"
Application.DisplayAlerts = True
ActiveWorkbook.Close False
MsgBox ("Please open a new email addressed to Cathy Mandeville, and attach the file named Store #" & storenumber & " - SEND THIS FILE To Cathy.xls")

Else

MsgBox "Please Finish Adjustments"
'user chose not to send file yet
End
End If

ThisWorkbook.Saved = True
ActiveWorkbook.FollowHyperlink Address:="https://webmail.albertsons.com/exchange", _
NewWindow:=True

Application.Quit
Application.DisplayAlerts = True
Application.ScreenUpdating = True

End Sub

Thanks for the help in advance.

 

[leeloo0505]

Help with posted web code

Okay, seems I am a little late getting on the bus.. but I am just trying to manipulate and send/extract data from a website and already ran into a wall.
I have the below code and the application/website opens but the SendKeys do not seem to do anything. I am trying to tab 8 times to get to the Email link and then hit 'Enter' to enter the email login page.
I have added MS Internet Controls to my References but that didn't seem to help any. If someone could give me a 'push' on this .... sure would appreciate it.

Sub openWeb()
Dim IE As Object

Set IE = CreateObject("InternetExplorer.application")
IE.Visible = True
IE.navigate "http://www.nextwaveisp.com"


Do
If IE.readystate = 4 Then
IE.Visible = False
Exit Do
End If
Loop

Application.Wait (Now + TimeValue("0:00:01"))
IE.Visible = True

For i = 1 To 8
SendKeys "{TAB}", True
Next i
SendKeys "{ENTER}", True



End Sub

 

[Joe Was]

I tested your code and it worked for me?

You need to run the code from a Standard module, like: Module1

To get a module like this, you need to open the Editor [Alt+F11] then from the toolbar: Insert - Module

Then paste a copy [Cut] of the your code to the module.

The code went to the password page, OK!

The References I have set are:

Visual Basic for Applications
Microsoft Excel 10.0 Object Library
OLE Automation
Microsoft Office 10.0 Object Library

 

[Norie]

This will get all the data into Excel, but admittedly it's a bit of a mess.

Sub Test()
    
    Set ie = CreateObject("InternetExplorer.Application")
    With ie
        .Visible = True
        .Navigate "http://online.wsj.com/mdc/public/page/2_3024-NYSE.html?mod=mdc_h_usshl"
        Do Until .ReadyState = 4: DoEvents: Loop
       
        Do Until .ReadyState = 4: DoEvents: Loop
        Do While .Busy: DoEvents: Loop
        Set doc = ie.Document
        GetAllTables doc
        .Quit
    End With
End Sub

Sub GetAllTables(d)
    For Each e In d.all
        If e.nodename = "TABLE" Then
            Set t = e
    
            tabno = tabno + 1
            nextrow = nextrow + 1
            Set rng = Range("B" & nextrow)
            rng.Offset(, -1) = "Table " & tabno
            For Each r In t.Rows
                For Each c In r.Cells
                    rng.Value = c.innertext
                    Set rng = rng.Offset(, 1)
                    I = I + 1
                Next c
                nextrow = nextrow + 1
                Set rng = rng.Offset(1, -I)
                I = 0
            Next r
        End If
    Next e
End Sub

 

[menor59]

Question:

Code from above:

Sub myWebOpenPW()
'Open site if it requires a PassWord Model!
Dim IE As Object

Set IE = CreateObject("InternetExplorer.Application")
IE.Visible = True

'Go to this Web Page!
IE.Navigate "http://YourLoggOnPageAddress_GosHere"

'Check for good connection to web page loop!
Do
If IE.ReadyState = 4 Then
IE.Visible = False
Exit Do
Else
DoEvents
End If
Loop

'Wait for window to open!
Application.Wait (Now + TimeValue("0:00:01"))
'MsgBox "Done"
IE.Visible = True

'Send logg-on information!
'May need additional SendKeys as needed?
'Determine by the actual key-stroks needed!
SendKeys "UserID_GosHere", True
SendKeys "{TAB}", True
SendKeys "PassWord_GosHere", True
SendKeys "{ENTER}", True
End Sub


Is there a way to get this to work on lets say you are on an active sheet

in cell A1 you have
Enter User Name:

in cell A2 you have
Enter Password:

in B1 you enter your Username
in B2 you enter your password

When you click a button that is tied to the code above it would put the values from B1 and B2 in the code...

eg.

'Send logg-on information!
'May need additional SendKeys as needed?
'Determine by the actual key-stroks needed!

SendKeys "UserID_GosHere", True <<<<<<<<<<<<<B1< p> B1 in place of "UserID_GosHere"
SendKeys "{TAB}", True
SendKeys "PassWord_GosHere", True <<<<<<<<<<<<B2< p> B2 in place of "PassWord_GosHere"
SendKeys "{ENTER}", True
End Sub

Once the Webmail page opens up automatically attach the Activesheet Clearing B1 & B2

and automatically put 2 recipients of the email in the TO section of the webmail app.

Lastly when you are done sending the Webmail save the active sheet with the current day and time in say C:\timesheets when you Close the Workbook automatically save on Exiting the Workbook.

The Subject should have something to the effect of

Timesheet email for (todays date which I believe would be =Now), for the week of (The first sunday of the current week).

Thank you so much.

 

[mathchick]

I know this is an old one, but just an fyi to be careful running this one. I got stuck in a loop with

SendKeys "{ENTER}", True

and had to restart my computer without being able to save anything because my computer was receiving an enter continuously preventing me from being able to do anything (I'm just glad I shut it down before it did something besides fill up a word doc and prevent me from opening/closing programs). Probably an amateur mistake that no one else would make, but figured I'd mention it in case anyone references this in the future.
For testing purposes I stuck a

[I]dim x as integer
do while x < 10
x = x+1 [/I]

in there instead of just do to prevent an endless loop.