SendKeys

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Hallo,
es wird ein Script erstellt und ausgeführt, am Ende wird diese Datei wieder gelöscht.

Option Explicit
Public Declare Function ShellExecute Lib "shell32.dll" Alias _
    "ShellExecuteA" (ByVal hWnd As Long, _
                     ByVal lpOperation As String, _
                     ByVal lpFile As String, _
                     ByVal lpParameters As String, _
                     ByVal lpDirectory As String, _
                     ByVal nshowcmd As Long) As Long
Dim sFile As String

Sub MailSenden()
Dim MyOutApp As Object, MyMessage As Object



Set MyOutApp = CreateObject("Outlook.Application")
Set MyMessage = MyOutApp.CreateItem(0)
Call SicherheitPress 'Scriptdatei erstellen 
    
    With MyMessage
        .To = "Excel@tinomargit.com"
        .Subject = "hier der Betreff"
        .body = "Hallo, hier die gewünschte Grafik" & String(3, vbCrLf)
        .Send
    End With

'Script löschen 
Kill sFile
End Sub

Private Sub SicherheitPress()
Dim F As Integer
Dim sLines As String

sLines = "Set ws = CreateObject(""Wscript.shell"") " & vbCrLf & _
        "WScript.sleep 7000" & vbCrLf & _
        "ws.SendKeys ""{Left}""" & vbCrLf & _
        "ws.SendKeys ""{Enter}"""


sFile = IIf(Right$(ThisWorkbook.Path, 1) = "\", ThisWorkbook.Path, ThisWorkbook.Path & "\")
sFile = sFile & "VBSScript.vbs"
  
  F = FreeFile
  Open sFile For Output As #F
  Print #F, sLines
  Close #F

'Script starten 
Call ShellExecute(0, "open", sFile, "", "", 0)
End Sub

Gruß Tino

Option Explicit Declare Function GetKeyState Lib "user32.dll" (ByVal nVirtKey As Long) As Integer Private Declare Sub keybd_event Lib "user32" ( _ ByVal byteVirtualKeycode As Byte, _ ByVal byteScan As Byte, _ ByVal lFlags As Long, _ ByVal lExtraInfo As Long) Sub MailSenden() Dim MyOutApp As Object, MyMessage As Object Set MyOutApp = CreateObject("Outlook.Application") Set MyMessage = MyOutApp.CreateItem(0) With MyMessage .To = "Mustermann@Proviter.de" .Subject = "hier der Betreff" .body = "Hallo," & String(3, vbCrLf) & "das ist ein test!" .Display AppActivate .Subject 'Titel der Mail, eventuell anpassen End With Application.SendKeys "%s" Call CheckNumLock 'Bug bei SendKeys, Num- Taste wieder aktivieren. End Sub Private Sub CheckNumLock() Const KEYEVENTF_KEYUP As Long = &H2 Const VK_NUMLOCK = &H90 If Not (GetKeyState(vbKeyNumlock) = 1) Then keybd_event VK_NUMLOCK, 1, 0, 0 keybd_event VK_NUMLOCK, 1, KEYEVENTF_KEYUP, 0 End If End Sub

Beliebteste Forumthreads (12 Monate)

18 Beiträge zum Forumthread Beiträge zu diesem Forumthread

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

18
Beiträge zum Forumthread

Beiträge zu diesem Forumthread