Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
884to888
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
884to888
884to888
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Inhaltsverzeichnis

Mailversand

Mailversand
10.07.2007 16:03:10
Thomas
Hallo,
ich benutze zum versenden einer Arbeitsmappe folgenden VBA-Code:

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If Target.Address = ("$C$8") Then
On Error GoTo fehler
If Application.MailSystem = xlMAPI Then
ActiveWorkbook.SendMail Recipients:=[D13], Subject:=[D14]
MsgBox "Die Mail wurde mit xlMAPI versendet."
GoTo ende
Else
Dim wb As Workbook
Dim TempFilePath As String
Dim TempFileName As String
Dim iMsg As Object
Dim iConf As Object
Dim Flds As Variant
Set wb = ActiveWorkbook
With Application
.ScreenUpdating = False
.EnableEvents = False
End With
TempFilePath = Environ$("temp") & "\"
TempFileName = wb.Name & " " & Format(Now, "yymmdd-hh.mm") & ".xls"
wb.SaveCopyAs TempFilePath & TempFileName
Set iMsg = CreateObject("CDO.Message")
Set iConf = CreateObject("CDO.Configuration")
iConf.Load -1
Set Flds = iConf.Fields
With Flds
.Item("http:// _
schemas.microsoft.com/cdo/configuration/sendusing")
= 2
.Item("http:// _
schemas.microsoft.com/cdo/configuration/smtpserver")
= [D17] 'SMTP Server
.Item("http:// _
schemas.microsoft.com/cdo/configuration/smtpserverport")
= 25
.Update
End With
With iMsg
Set .Configuration = iConf
.To = [D13] 'Empfänger
.CC = ""
.BCC = ""
.From = "" & [D15] & "" 'Name - Adresse
.Subject = [D14]
.TextBody = "Excel-Datei im Anhang"
.AddAttachment TempFilePath & TempFileName
.Send
End With
Kill TempFilePath & TempFileName
With Application
.ScreenUpdating = True
.EnableEvents = True
End With
MsgBox "Die Mail wurde mit xlNoMailSystem versendet."
GoTo ende
End If
fehler:
MsgBox "Fehler.Mail nicht gesendet."
ende:
Cancel = True
End If
End Sub


Das funktioniert zwar ganz gut, aber es gibt User die haben Outlook installiert, aber nicht eingerichtet, weil die z.B. Thunderbird (Mozilla) verwenden. Nun erkennt Excel aber die Installation von Outlook und stellt viele Fragen... Wenn ich direkt mit CDO senden will kommt bei installiertem Outlook immer ein Fehler bei .send.
Ist es möglich, trotz installiertem Outlook über CDO zu senden? Wie müßte ich Outlook umgehen?

4
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Mailversand
10.07.2007 19:36:00
Thomas
Hallo,
also der Mailversand über CDO geht an Outlook vorbei. Das Problem ist, das die cdo.dll nicht auf allen PCs installiert ist. Somit hat sich die Frage also erledigt. Das Makro kann also abgeändert werden und es bleibt nur noch der CDO-Versand übrig.
Jetzt werde ich nach einer Möglichkeit suchen wie die CDO.DLL beim fehlen nachinstalliert werden kann.
Tschüß Thomas.

AW: Mailversand
10.07.2007 23:25:06
Thomas
Hallo,
für den Fall das es noch jemanden interessiert..
Also die CDO.dll ist vorhanden, die heißt nur CDOSYS.dll. Das Problem lag an was anderem.
Wenn Outlook Express oder Windows Mail genutzt wurde, kam es zu Fehlern mit der SMTP Angabe auf anderen Rechnern. Daher habe ich jetzt den Code folgender Maßen verändert. Das hat nun auf 6 verschieden konfigurierten Systemen bestens funktioniert:

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If Target.Address = ("$C$8") Then 'Ereigniss zum auslösen des Codes
On Error GoTo anders 'wenn Outloock Express nicht eingerichtet ist kommt .send Fehler
Dim wb As Workbook
Dim TempFilePath As String
Dim TempFileName As String
Dim iMsg As Object
Dim iConf As Object
Dim Flds As Variant
Set wb = ActiveWorkbook
With Application
.ScreenUpdating = False
.EnableEvents = False
End With
TempFilePath = Environ$("temp") & "\"
TempFileName = wb.Name & " " & Format(Now, "yymmdd-hh.mm") & ".xls"
wb.SaveCopyAs TempFilePath & TempFileName
Set iMsg = CreateObject("CDO.Message")
Set iConf = CreateObject("CDO.Configuration")
With iMsg
Set .Configuration = iConf
.To = [D13] ' Empfänger
.CC = ""
.BCC = ""
.Subject = [D14] ' Betreff
.TextBody = "Test Text" ' Mailtext
.AddAttachment TempFilePath & TempFileName
.Send
End With
GoTo weiter
anders: 'weiter nach Fehler, mit SMTP Server
On Error GoTo fehler 'geht das auch nicht - Fehlermeldung
Set iMsg = CreateObject("CDO.Message")
Set iConf = CreateObject("CDO.Configuration")
iConf.Load -1
Set Flds = iConf.Fields
With Flds
.Item("http:// _
schemas.microsoft.com/cdo/configuration/sendusing")
= 2
.Item("http:// _
schemas.microsoft.com/cdo/configuration/smtpserver")
= [D17] ' SMTP-Server
.Item("http:// _
schemas.microsoft.com/cdo/configuration/smtpserverport")
= 25
'.Item(" _
http://schemas.microsoft.com/cdo/configuration/smtpauthenticate")
= 1
'.Item("http:// _
schemas.microsoft.com/cdo/configuration/sendusername")
= "username"
'.Item("http:// _
schemas.microsoft.com/cdo/configuration/sendpassword")
= "password"
.Update
End With
With iMsg
Set .Configuration = iConf
.To = [D13] ' Empfänger
.CC = ""
.BCC = ""
.From = "" & [D15] & "" 'Name, Absender
.Subject = [D14] ' Betreff
.TextBody = "Test Text" ' Mailtext
.AddAttachment TempFilePath & TempFileName ' Dateianhang
.Send
End With
GoTo weiter
fehler: ' Fehler fals es garnicht geht
MsgBox "Mail nicht versandt."
weiter:
Kill TempFilePath & TempFileName
With Application
.ScreenUpdating = True
.EnableEvents = True
End With
Cancel = True
End If
End Sub


So funktioniert das ganze komplett unabhängig vom installiertem Mailsystem.
Tschüß Thomas.

Anzeige
AW: Mailversand
11.07.2007 20:06:52
Thomas
Hallo Bernd,
da muß ich aber mal mit meinem Kumpel schimpfen, von dem ich den Code bekommen habe ;o) hätt mir seine Quelle auch gleich sagen können. Ja, das is der Code und auch noch bestens erklärt. Danke Dir für den Link.
Thomas

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige