hier noch eine Möglichkeit...
25.04.2009 12:34:06
Tino
Hallo,
..., hierzu wird folgende .dll und .exe Datei benötigt.
https://www.herber.de/bbs/user/61416.zip
Am einfachsten diese im Ordner der Excel- Datei ablegen.
Provider Konfiguration musst Du noch anpassen.
Option Explicit
Private Declare Function CharToOemA Lib "user32.dll" (ByVal _
lpszSrc As String, ByVal lpszDst As String) As Long
Public Function ANSItoASCII(ByVal Text As String) As String
Call CharToOemA(Text, Text)
ANSItoASCII = Text
End Function
Public Sub SendMail(xTo As String, xSubject As String, xBody As String, Optional xAttach = "")
Dim ff As Integer
Dim strPfad As String, strPfadTemp As String, cmd As String
Dim regExe As Long
' ### folgende Konstanten müssen angepasst werden!! ###########################################
Const xServer = "Postausgangsserver" 'SMTP-Server
Const xUser = "Mustermann@Provider.com" 'Username
Const xPassword = "Passwort" 'Passwort
Const xFrom = "Mustermann@Provider.com" 'Absenderadresse
'##############################################################################################
'Pfade b.B. auch anpassen, voreingestellt ist hier der Pfad der Excel-Mappe:
'hier steht das Programm blat.exe
strPfad = IIf(Right$(ThisWorkbook.Path, 1) = "\", ThisWorkbook.Path, ThisWorkbook.Path & "\")
'hier wird mailbody.txt erzeugt, also Schreibrecht benötigt!
strPfadTemp = IIf(Right$(ThisWorkbook.Path, 1) = "\", ThisWorkbook.Path, ThisWorkbook.Path & "\")
'Mailbody in Textdatei scheiben
ff = FreeFile
Open strPfadTemp & "mailbody.txt" For Output As ff
Print #ff, xBody
Close ff
'Shell-Befehl zusammenbauen:
cmd = """" & strPfad & "blat.exe"" """ & strPfadTemp & "mailbody.txt"" -server " & _
xServer & " -u " & xUser & " -pw " & xPassword & " -f """ & _
xFrom & """ -to " & xTo & " -s """ & xSubject & """"
'bei Bedarf auch den Anhang:
If xAttach <> "" Then cmd = cmd & " -attach """ & xAttach & """"
cmd = ANSItoASCII(cmd)
'BLAT.EXE ausführen
Shell cmd, vbHide
'warten bis Mail gesendet, eventuell anpassen
Application.Wait Now + TimeSerial(0, 0, 6)
'Bodyfile löschen
Kill strPfadTemp & "mailbody.txt"
End Sub
'zum Testen:
Sub SendenDeinerMail()
Dim MailDatei As Workbook
Dim strPathFull As String
'Anlage erstellen ************
ActiveSheet.Copy
Set MailDatei = ActiveWorkbook
strPathFull = IIf(Right$(ThisWorkbook.Path, 1) = "\", ThisWorkbook.Path, ThisWorkbook.Path & "\") & "MailDatei.xls" 'Name anpassen
MailDatei.SaveAs strPathFull
MailDatei.Close False
'*****************************
'Senden an ; Betreff ; Body ; Optional Anlage
SendMail "excel@tinomargit.com", "So geht's weiter", "Hallo du!" & vbLf & "Wie geht's?", strPathFull
'Anlage löschen************
Kill strPathFull
End Sub
Gruß Tino