Open website with login and paswd using VBA

The program requires references to the following:

1 Microsoft Internet Controls
2. Microsoft HTML Object Library

The Internet control is used to browse the webpage and the HTML Objects are used to identify the username and password textboxes and submit the text using the control button.

Dim HTMLDoc As HTMLDocument
Dim oBrowser As InternetExplorer
Sub Login_2_Website()

Dim oHTML_Element As IHTMLElement
Dim sURL As String

On Error GoTo Err_Clear
sURL = "https://www.google.com/accounts/Login"
Set oBrowser = New InternetExplorer
oBrowser.Silent = True
oBrowser.timeout = 60
oBrowser.navigate sURL
oBrowser.Visible = True

Do
' Wait till the Browser is loaded
Loop Until oBrowser.readyState = READYSTATE_COMPLETE

Set HTMLDoc = oBrowser.Document

HTMLDoc.all.Email.Value = "sample@vbadud.com"
HTMLDoc.all.passwd.Value = "*****"

For Each oHTML_Element In HTMLDoc.getElementsByTagName("input")
If oHTML_Element.Type = "submit" Then oHTML_Element.Click: Exit For
Next

' oBrowser.Refresh ' Refresh If Needed
Err_Clear:
If Err <> 0 Then
Debug.Assert Err = 0
Err.Clear
Resume Next
End If
End Sub

Create Barchart using "REPT" function.

Here is the example of REPT function. To create BarChart

 

Units	Days	Share	Function
100	Sunday	|||||  5%	=REPT("|",100*A2/$A$9) &"  "& TEXT(A2/$A$9,"0%")
150	Monday	|||||||  8%	=REPT("|",100*A3/$A$9) &"  "& TEXT(A3/$A$9,"0%")
450	Tuesday	||||||||||||||||||||||  23%	=REPT("|",100*A4/$A$9) &"  "& TEXT(A4/$A$9,"0%")
300	Wednesday	|||||||||||||||  15%	=REPT("|",100*A5/$A$9) &"  "& TEXT(A5/$A$9,"0%")
300	Thursday	|||||||||||||||  15%	=REPT("|",100*A6/$A$9) &"  "& TEXT(A6/$A$9,"0%")
400	Friday	||||||||||||||||||||  20%	=REPT("|",100*A7/$A$9) &"  "& TEXT(A7/$A$9,"0%")
300	Saturday	|||||||||||||||  15%	=REPT("|",100*A8/$A$9) &"  "& TEXT(A8/$A$9,"0%")
2000	Total

 

http://www.vbatalent.blogspot.com

---

Now, send attachments up to 25MB with Yahoo! India Mail. Learn how.

Remove workbook password.

'****************************************************************************
' Main procedure
' Open the workbook which you wants to remove password and run the procedure
'****************************************************************************
Sub PasswordBreaker1()

Dim wkb As Excel.Workbook
Set wkb = ActiveWorkbook

Dim i As Integer, j As Integer, k As Integer
Dim l As Integer, m As Integer, n As Integer
Dim i1 As Integer, i2 As Integer, i3 As Integer
Dim i4 As Integer, i5 As Integer, i6 As Integer
On Error Resume Next
For i = 65 To 66: For j = 65 To 66: For k = 65 To 66
For l = 65 To 66: For m = 65 To 66: For i1 = 65 To 66
For i2 = 65 To 66: For i3 = 65 To 66: For i4 = 65 To 66
For i5 = 65 To 66: For i6 = 65 To 66: For n = 32 To 126

ActiveWorkbook.Unprotect Chr(i) & Chr(j) & Chr(k) & _
Chr(l) & Chr(m) & Chr(i1) & Chr(i2) & Chr(i3) & _
Chr(i4) & Chr(i5) & Chr(i6) & Chr(n)

Application.StatusBar = Chr(i) & Chr(j) & Chr(k) & _
Chr(l) & Chr(m) & Chr(i1) & Chr(i2) & Chr(i3) & _
Chr(i4) & Chr(i5) & Chr(i6) & Chr(n)

If Not IsProtected(wkb) Then
MsgBox "One usable password is " & Chr(i) & Chr(j) & _
Chr(k) & Chr(l) & Chr(m) & Chr(i1) & Chr(i2) & _
Chr(i3) & Chr(i4) & Chr(i5) & Chr(i6) & Chr(n)

Application.StatusBar = False

Exit Sub

End If
Next: Next: Next: Next: Next: Next
Next: Next: Next: Next: Next: Next

End Sub

 

Function IsProtected(objXL As Object) As Boolean
Dim wksht As Excel.Worksheet
Dim cell As Excel.Range
Select Case TypeName(objXL)
 
  Case "Workbook"
    If objXL.ProtectStructure Then
      IsProtected = True
      Exit Function
    Else
        IsProtected = False
      Exit Function
    End If
End Select
End Function

---

Add whatever you love to the Yahoo! India homepage. Try now!