Dotaz z Webu přes Makro kameru a VBA.

[kosmodrak]

Problém: Přes makro kameru jsem pustil dotaz z webu s odkazem na chráněný web, kdy pro přihlášení je nutné login a heslo. To jsem zadával přes Makro kameru. Když makro následně pouštím, tak jednou se mi data načtou poté ne, pak zase ano, pak ne. Problém je pravděpodobně v zadání uživatelského jména a hesla pro přihlášení do web aplikace. Nicméně v té syntaxi ve VBA se mi zobrazuje pouze odkaz na webové stránky, nikoliv již jakýkoliv odkaz na syntaxi, kde zadávám login a heslo. Nevíte, kde se může login a heslo ukládat, pokud jsem je zadával v rámci makro kamery?

[Reklama]

[cmuch]

Koukni tady
http://vbadud.blogspot.cz/2009/08/how-t ... g-vba.html

[pavel.lasak]

pošli ukázku kódu co nahrálo makro. Problém je asi v tom, že automatické nahrávání makra nezaznamená všechy akce co jako uživatel provedeš.

[kosmodrak]

podle toho odkazu se nemůžu zorientovat, takže makro je tady:

With ActiveSheet.QueryTables.Add(Connection:= _
"URL;http://emxxx.xxxxxxxxxxxx.cz/devices.aspx", Destination:=Range("$A$1"))
.Name = "devices"
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.BackgroundQuery = True
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.WebSelectionType = xlEntirePage
.WebFormatting = xlWebFormattingNone
.WebPreFormattedTextToColumns = True
.WebConsecutiveDelimitersAsOne = True
.WebSingleBlockTextImport = False
.WebDisableDateRecognition = False
.WebDisableRedirections = False
.Refresh BackgroundQuery:=False
End With

[kosmodrak]

Tak nikdo není na tolik master v makrech, aby mi poradil??

[cmuch]

No ten tvůj útržek kódu je nic neříkající.
Pokud je to jen možné tak by to chtělo sešit a adresu kam se chceš přihlásit

Jinak to makro výše mě přihlásí na účet u googlu (napsat jméno a heslo)
i na Seznam (ale makro je trochu jiné, viz níže)

Prvně se musí ve VBA (Alt+F11) povolit v nabídce Tools -- Reference...
To co je na těch obrázkách a pak to jde.

Na některé stránky se mi nepodařilo přihlásit!!

Přihlášení do Googlu

Kód: Vybrat vše

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 = "jmeno@gmail.com"
 HTMLDoc.all.passwd.Value = "heslo"

 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
    Err.Clear
    Resume Next
 End If
End Sub


Přihlášení na Seznam

Kód: Vybrat vše

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 = "http://login.szn.cz/?serviceId=homepage&loggedURL=http%3A%2F%2Fwww.seznam.cz%3Flogged%3D1%23obsah"
 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.UserName.Value = "jmeno"
 HTMLDoc.all.Password.Value = "heslo"

 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