Live-Forum - Die aktuellen Beiträge
Datum
Titel
29.03.2024 13:14:12
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
1476to1480
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

Emails aus Excel versenden

Emails aus Excel versenden
22.02.2016 22:24:15
Kulo
Hallo an Alle,
mit folgendem Code möchte ich gern Emails aus Excel verschicken:
Private Sub EmailLKW2()
Dim objOutlook As Outlook.Application
Dim objMail As Outlook.MailItem
Set objOutlook = New Outlook.Application
Set objMail = objOutlook.CreateItem(olMailItem)
With objMail
.Recipients.Add Worksheets("LKW").Range("B3").Value
.Subject = Worksheets("LKW").Range("A1").Value
.Body = Worksheets("LKW").Range("E8").Value
.Display
.Send
End With
End Sub
Bis zur Anzeige der Email läuft alles Prima. Nur das Senden geht nicht automatisch, wenn Outlook noch nicht geöffnet ist.
Ich dachte, dass dieser Code Outlook öffnet, falls nicht bereits offen.
In den ersten zwei Zeilen wird der Wert der Variablen mit "= Nothing" angezeigt.
Nach dem Anzeigen der Email wird das Emailfenster geschlossen. Erst wenn ich dann Outlook manuell öffne, werden die Emails, welche sich dort im Postausgang befinden, verschickt. Das sollte aber ohne mein Zutun passieren.
Was mache ich falsch? Kann mir da bitte jemand helfen?
VG
Kulo

1
Beitrag zum Forumthread
Beitrag zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Emails aus Excel versenden
23.02.2016 00:09:19
Raphael
Hallo Kulo,
in deinem Code wird lediglich ein Outlookobjekt erstellt und im Postausgang abgelegt. Das Programm wird nicht direkt geöffnet.
Ich denke diesen Code könntest du nutzten. Aber evtl. gehts auch einfacher und eleganter.
Der erste Teil, die API Declare und die Function sind von Sepp (Ehrensberger)

Option Explicit
Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As _
Long
Private Declare Function OpenProcess Lib "kernel32" (ByVal dwDesiredAccess As _
Long, ByVal bInheritHandle As Long, ByVal dwProcessId As Long) As Long
Private Declare Function TerminateProcess Lib "kernel32" (ByVal hProcess As _
Long, ByVal uExitCode As Long) As Long
Private Declare Function ShowWindow Lib "user32" (ByVal hWnd As Long, ByVal _
nCmdShow As Long) As Long
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal _
lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare Function GetWindowThreadProcessId Lib "user32" (ByVal hWnd As _
Long, lpdwProcessId As Long) As Long
Private Declare Function GetWindow Lib "user32" (ByVal hWnd As Long, ByVal wCmd _
As Long) As Long
Private Declare Function GetParent Lib "user32" (ByVal hWnd As Long) As Long
Private Const PROCESS_TERMINATE = &H1
Private Const GW_HWNDNEXT As Long = &H2
Private Const SW_MINIMIZE = &H6
Private Const SW_RESTORE = &H9
Public lTaskID As Long
Public hWnd As Long
Private Retval As Long
Private Function ShellTohWnd(ByVal hhwPfad As String, Optional Mode As VbAppWinStyle)
Dim ProcHWN As Long
lTaskID = Shell(hhwPfad, Mode)
Retval = FindWindow(vbNullString, vbNullString)
Do While Retval  0
If GetParent(Retval) = 0 Then
Call GetWindowThreadProcessId(Retval, ProcHWN)
If ProcHWN = lTaskID Then
ShellTohWnd = Retval
Exit Do
End If
End If
Retval = GetWindow(Retval, GW_HWNDNEXT)
Loop
End Function
Sub Schliessen()
Dim hTask As Long
Dim lResult As Long
If lTaskID > 0 Then
hTask = OpenProcess(PROCESS_TERMINATE, 0&, lTaskID)
lResult = TerminateProcess(hTask, 1&)
lResult = CloseHandle(hTask)
lTaskID = 0
hWnd = 0
End If
End Sub
Private Sub EmailLKW2()
Dim objOutlook As Object
Dim objMail As Object
Dim Ol As Object
Dim olF As Object
Dim olNs As Object
lTaskID = 0
'Hier den Pfad anpassen in der deine Outlook.exe liegt
hWnd = ShellTohWnd("C:\....\OUTLOOK.EXE", vbHide)
Set objOutlook = CreateObject("Outlook.Application")
Set objMail = objOutlook.CreateItem(0)
With objMail
.Recipients.Add Worksheets("LKW").Range("B3").Value
.Subject = Worksheets("LKW").Range("A1").Value
.Body = Worksheets("LKW").Range("E8").Value
.Display
.Send
End With
'Outlook aufgreifen und prüfen ob der Postausgang leer ist
Set Ol = GetObject(, "outlook.Application")
Set olNs = Ol.getnamespace("mapi")
Set olF = olNs.getdefaultfolder(4) 'olFolderOutbox
'Warten bis der Outlookausgang leer ist und danach Outlook schliessen
Do
Application.Wait (Now + TimeValue("0:00:01"))
Loop While (olF.Items.Count > 0)
Call Schliessen
End Sub

Anzeige

76 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige