3
\$\begingroup\$

I created an automatic upload tool, which is working great (most of the time). As I want to improve the code I have several questions:

  1. Is it possible to make the iexplorer process smoother? I don't like it that people can see the "sendkeys" actions. Is there possibly way to run the process in the background/lay a picture over the process? In addition to that, is there a way to block the user's input for some seconds? I know the opportunity of the blockinput command, but unfortunately it doesn't work.
  2. Is it possible to close the browsers site (only the one, which was opened for the upload!) and return to Excel?

Sub speichern_unter()
Application.DisplayAlerts = False
Dim str_pfad As String
str_pfad = Environ("UserProfile") & "\Desktop\" 'Die Datei wird auf den Desktop gespeichert
Rem MsgBox str_pfad
ActiveWorkbook.SaveAs str_pfad & ActiveSheet.Range("m1").Value & ".xlsm" 'Diese Zelle gibt den Tabellennamen vor

'Zur Sicherheit wird eine zusätzliche Backup-Datei an eine E-Mail verschickt (optional)
MsgBox "Eine Backup-Datei wird erstellt und per Mail verschickt. Bitte bestätigen Sie im nachfolgenden Fenster mit 'erteilen'", , "OK"
ActiveWorkbook.SendMail "###@###.de", "###Dateiname###"
Application.DisplayAlerts = True

'Ab hier beginnt der Upload-Vorgang
MsgBox "Die Datei wird nun ins ### geladen. Dies kann einige Sekunden dauern! Bitte beachten Sie, dass Sie hierfür im ### eingeloggt sein müssen!", , "OK"
MsgBox "Berühren Sie während des Vorganges nicht die Maus oder Tastatur! (Dauer ca. 30 Sekunden)", , "OK"
Dim appIE As Object
Set appIE = CreateObject("InternetExplorer.Application")
'appIE.Visible = False
appIE.navigate "https://###/docs/DOC-257603/upload#" 'Link zur "Bearbeiten" Seite im TSN
While appIE.Busy
        DoEvents
Wend
Application.Wait (Now + TimeValue("0:00:05"))
SendKeys "+{TAB}", True
SendKeys "{ENTER}"
Application.Wait (Now + TimeValue("0:00:04"))
SendKeys "{TAB}"
SendKeys "{TAB}"
SendKeys "{TAB}"
SendKeys "{TAB}"
SendKeys "{ENTER}"
Application.Wait (Now + TimeValue("0:00:01"))
SendKeys "Desktop/"
SendKeys "{Enter}"
Application.Wait (Now + TimeValue("0:00:01"))
SendKeys "{TAB}"
SendKeys "{TAB}"
SendKeys "{TAB}"
SendKeys "{TAB}"
SendKeys "{TAB}"
Application.Wait (Now + TimeValue("0:00:01"))
SendKeys "###Dateiname###.xlsm"
SendKeys "{ENTER}"
Application.Wait (Now + TimeValue("0:00:04"))
'Nachfolgender Ausdruck löscht den bisherigen Namen aus dem Textfeld
SendKeys "{DEL}", True
SendKeys "{DEL}", True
SendKeys "{DEL}", True
SendKeys "{DEL}", True
SendKeys "{DEL}", True
SendKeys "{DEL}", True
SendKeys "{DEL}", True
SendKeys "{DEL}", True
SendKeys "{DEL}", True
SendKeys "{DEL}", True
SendKeys "{DEL}", True
SendKeys "{DEL}", True
SendKeys "{DEL}", True
SendKeys "{DEL}", True
SendKeys "{DEL}", True
SendKeys "{DEL}", True
SendKeys "{DEL}", True
SendKeys "{DEL}", True
SendKeys "{DEL}", True
SendKeys "{DEL}", True
SendKeys "{DEL}", True
SendKeys "{DEL}", True
SendKeys "{DEL}", True
SendKeys "{DEL}", True
SendKeys "{DEL}", True
Application.Wait (Now + TimeValue("0:00:03"))
SendKeys "###Dateiname###", True 'Hier wird der spätere Name der Datei definiert
Application.Wait (Now + TimeValue("0:00:03"))
SendKeys "{ENTER}"

MsgBox "Die Datei wurde ergfolgreich hochgeladen", , "OK"

End Sub
\$\endgroup\$
  • 4
    \$\begingroup\$ Does the HTTPS server you're trying to reach allow you to use GET and POST? You could avoid using InternetExplorer and SendKeys, and use WinHttpRequest or XMLHttpRequest to send the data? \$\endgroup\$ – ThunderFrame May 27 '16 at 12:23
6
\$\begingroup\$

There's a huge problem with using SendKeys to do anything. The very second the target UI changes at all, your code is broken. As was mentioned in the comments, the right way to do this is by POSTing to the URL.

  1. Use a tool like Telerik Fiddler to sniff out the contents of the http request that occurs when you click the Submit button on the target page.
  2. Add a reference to the WinHttpRequest library.
  3. Use the library to POST to the target URL.

    const url As String = "https://###/docs/DOC-257603/upload#"
    
    Dim httpRequest = New WinHttpRequest
    httpRequest.Open "POST", url, False
    httpRequest.SetRequestHeader "headerName", "and header values you sniffed out"
    httpRequest.Send "content based on request you spied on"
    
\$\endgroup\$

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

Not the answer you're looking for? Browse other questions tagged or ask your own question.