Question

我创建了一个自动上传工具，工作得很好（大部分时间）。由于我想改进代码，我有几个问题： 1）是否有可能使iexplorer进展更顺畅？我不喜欢人们可以看到“sendkeys”动作。是否有可能在后台运行进展/在杂货上打一张照片？除此之外，是否有可能阻止用户输入几秒钟？我知道blockinput命令的机会，但不幸的是它不起作用。 2）是否可以关闭浏览器站点（只有为上传打开的站点！）并返回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

自动上传工具

0 个答案: