ho trovato questo codice in rete...ma non funziona....
ho provato a correggerlo ma senza successo....


consigli ?

Grazie

codice:
'L 'articolo cerca tra i processi attivi le istanze di IE, e se ne trova, inizia a

'ricercarvi,all'interno, gli eventuali controlli di tipo text e password.
'Una volta trovati i controlli li riempie con dei valori decisi a priori.


Option Explicit

Private winTitolo As String
'Verifico se l'oggetto passatomi e' un campo di tipo password type

Private Function IsPasswordBox(Elemento As Object) As Boolean
On Error GoTo err_password
If LCase(Elemento.getAttribute("Type")) = "password" Then
IsPasswordBox = True
Else
IsPasswordBox = False
End If
Exit Function
err_password:
IsPasswordBox = False
End Function

'Verifico se il campo e' una text box
Private Function IsTextBox(Elemento As Object) As Boolean
On Error GoTo err_text
If LCase(Elemento.getAttribute("Type")) = "text" Then
IsTextBox = True
Else
IsTextBox = False
End If
Exit Function
err_text:
IsTextBox = False
End Function

Private Function CercaCampi(Documento As Object) As Boolean
Dim Elemento As Object
Dim numOggetti As Long
Dim indiceOggetti As Long
Dim Trovato As Boolean
Dim ok As Integer
'calcolo il numero degli oggetti nel documento
numOggetti = Documento.All.length
'Scorro gli elementi fino a trovarne uno di tipo password o text
For indiceOggetti = 0 To numOggetti - 1
DoEvents
Set Elemento = Documento.All.Item(indiceOggetti)
'Verifico se e' una password-box e la riempio con la parola pippo
If IsPasswordBox(Elemento) Then
'Il false serve per rendere case-insensitive la ricerca
dell'attributo value
ok = Elemento.setAttribute("Value", "pippo", False)
Trovato = True
End If
'Verifico se e' una text-box e la riempio con la parola topolino
If IsTextBox(Elemento) Then
'Il false serve per rendere case-insensitive la ricerca
dell'attributo value
ok = Elemento.setAttribute("Value", "topolino", False)
Trovato = True
End If
Next
numOggetti = Documento.frames.length
'Eseguo la verifica anche su eventuali frame nella pagina
For indiceOggetti = 0 To numOggetti - 1
'Esegui la ricerca anche in questi frame
If CercaCampi(Documento.frames.Item(indiceOggetti).document)
Then Trovato = True
Next
CercaCampi = Trovato
End Function

Private Sub Scansiona()
Dim objShellWins As New SHDocVw.ShellWindows
Dim objExplorer As SHDocVw.InternetExplorer
Dim Documentoument As HTMLDocument
Dim Trovato As Boolean
Dim Eseguito As Boolean
Screen.MousePointer = vbHourglass
'Scorri tutte le fineste aperte
For Each objExplorer In objShellWins
If TypeOf objExplorer.document Is HTMLDocument Then
Set Documentoument = objExplorer.document
'Salva il titolo cosi' da poterle riconoscere
winTitolo = Documentoument.Title
'Inizio la ricerca nel documento
Eseguito = CercaCampi(Documentoument)
If Eseguito Then Trovato = True
End If
Next
Screen.MousePointer = vbDefault
End Sub

Private Sub cmdPasswords_Click()
call Scansiona
End Sub