Sendkeys not working properly (1 Viewer)

priya1987

New member
Local time
Today, 09:50
Joined
Sep 11, 2014
Messages
2
I am using Ms Access 2010.My vba code is below.
I try to download the file from the authenticated website.


Option Compare Database
Function Check()
Set IE = CreateObject("InternetExplorer.Application")
If [Forms]![Select Files Form]!Check2.Value = True Then
Dim LogForms As HTMLFormElement
Dim but As HTMLButtonElement
Dim signin As HTMLInputButtonElement
Dim lnk As HTMLLinkElement
Dim uName As HTMLInputElement
Dim uPass As HTMLInputElement
Dim doc As HTMLDocument
Dim db As Database
Set db = CurrentDb
Dim rs As Recordset
Dim FileNam As String
Dim UrlforFile As String
Dim SaveFile As String
Dim SourceFile As String
Dim TargetFile As String
Dim TargetFilezip As String
Dim dat1, dat2, dat3 As String
Dim DestFile, Zipout As String
Loop2:
Set IE = New InternetExplorer
IE.navigate "URL"
Do Until IE.ReadyState <> READYSTATE_COMPLETE Or IE.Busy: DoEvents: Loop
Sleep 1000
Set doc = IE.Document
Set LogForms = doc.Forms(0)
On Error GoTo Loop1
Set uName = LogForms.elements("txtUserName")
If uName Is Nothing Then
GoTo Loop1
End If
uName.Value = "UserName"
Set uPass = LogForms.elements("txtUserPass")
uPass.Value = "Password"
For Each lnk In doc.links
If lnk.innerHTML = "Log In" Then
lnk.Click
Sleep 1000
Dim appact As Double
IE.Visible = True
Set NodeList = doc.getElementsByTagName("h3")
For Each elm In NodeList
If elm.innerText = "Page may have been moved or has been retired." Then
SendMailError "Error msg"
MsgBox "No such file to download for the date "
IE.Quit
Exit Function
End If
Next
AppActivate "Title", True
SendKeys "%s", False

'IE.Visible = False
Sleep 1000
SaveFile = "zip file Path"
DestFile = "Source File Path"
DestFile1 = "Extract folder"
Dim FSO As Object
Dim FSize As Long
TargetFile = "File path to move the unzip file"
PathZipProgram = "C:\Program files\Winzip"
If Right(PathZipProgram, 1) <> "\" Then
PathZipProgram = PathZipProgram & "\"
End If
If Dir(PathZipProgram & "winzip32.exe") = "" Then
MsgBox "No Winzip in this system"
Exit Function
End If
'Call Unzip(DestFile1, SaveFile)
'ShellStr = PathZipProgram & "winzip32.exe -min -e" & " " & Chr(34) & SaveFile & Chr(34) & " " & Chr(34) & DestFile1 & Chr(34)
Sleep 1000
'ShellAndWait ShellStr, vbNormal
' Sleep 1000
Sleep 1000
Zipout = Shell("C:\Program files\Winzip\Winzip32 -min -e " & SaveFile & " " & DestFile1, vbNormalFocus)
Sleep 4000
SourceFile = SaveFile
FileRenameMove SourceFile, TargetFile
Sleep (1000)
Kill SaveFile
Kill SourceFile
RmDir DestFile1
MsgBox "Successfully downloaded file!"
IE.Quit
'IE.Visible = False
Exit Function
End If
Next
Loop1:
For Each lnk In doc.links
If lnk.innerHTML = "Log Out" Then
lnk.Click
IE.Visible = False
GoTo Loop2
End If
Next
Else
MsgBox "Checkbox unchecked.Please try again later."
End If
End Function
Sub FileRenameMove(ByVal SourceFile As String, ByVal TargetFile As String)
On Error GoTo ErrorHandler
If (FileLen(SourceFile) > 1100) Then
FileCopy SourceFile, TargetFile
Else
MsgBox (SourceFile & " File size too low")

End If
Error_exit:
Exit Sub
ErrorHandler:
Dim errormessage As String
Select Case Err.Number
Case Else
errormessage = "Error Number: " & Err.Number & vbCrLf & "Error Description: " & Err.Description
SendMailError "Error in File Download mdb - FileRenameMove", errormessage
IE.Quit
Debug.Assert (0)
Resume
End Select
End Sub

Error:
File download bar display in internet explorer.but sendkeys work if the focus lose from the ie.
How to resolve it.:banghead:
 

Users who are viewing this thread

Top Bottom