Supportnet / Forum / Tabellenkalkulation
Makro-um Tabelle per Mail zu versenden
Frage
hallo liebe leute,
hätte gerne ein makro um eine tabelle voll automatisiert an einen empfänger verschicken zu können...
ist das möglich? ohne auf "senden" drücken zu müssen??
Gruess + vilen dank
Mailinger
Antwort 1 von Ahnan
Hallo,
so kann es gehen:
Sub SendDatei()
Dim objSourceWb As Workbook
Dim objNewWb As Workbook
Dim strSubjectline As String
Dim strRecipient As String
Dim strTempPath As String
On Error GoTo SendError
strSubjectline = InputBox _
(Prompt:="Möchten Sie diese Datei versenden ?" & _
String(2, vbCr) & _
"Geben Sie eine Betreffzeile ein" & _
" oder klicken Sie auf Abbrechen.", _
Title:="Diese Datei senden")
If strSubjectline <> "" Then
strRecipient = InputBox _
("Bitte E-Mail-Empfaenger eingeben:", _
Title:="Diese Datei versenden")
If strRecipient <> "" Then
Application.ScreenUpdating = False
Set objSourceWb = ActiveWorkbook
Set objNewWb = ActiveWorkbook
With objNewWb
.SaveAs "Testdatei" & objSourceWb.Name
strTempPath = .FullName
.SendMail Recipients:=strRecipient, _
Subject:=strSubjectline
.Close SaveChanges:=False
Kill strTempPath
End With
Application.ScreenUpdating = True
End If
End If
SendEnd:
Set objNewWb = Nothing
Set objSourceWb = Nothing
Exit Sub
SendError:
MsgBox Prompt:="Fehler beim Senden der Datei " & _
"(" & Err.Number & "):" & vbCr & _
Err.Description
Resume SendEnd
End Sub
Dieses Makro auf eine Schaltfläche legen, oder sonst wie starten. Der Versand der Mail geht über Outlook.
Vielleicht hilfts
MfG
so kann es gehen:
Sub SendDatei()
Dim objSourceWb As Workbook
Dim objNewWb As Workbook
Dim strSubjectline As String
Dim strRecipient As String
Dim strTempPath As String
On Error GoTo SendError
strSubjectline = InputBox _
(Prompt:="Möchten Sie diese Datei versenden ?" & _
String(2, vbCr) & _
"Geben Sie eine Betreffzeile ein" & _
" oder klicken Sie auf Abbrechen.", _
Title:="Diese Datei senden")
If strSubjectline <> "" Then
strRecipient = InputBox _
("Bitte E-Mail-Empfaenger eingeben:", _
Title:="Diese Datei versenden")
If strRecipient <> "" Then
Application.ScreenUpdating = False
Set objSourceWb = ActiveWorkbook
Set objNewWb = ActiveWorkbook
With objNewWb
.SaveAs "Testdatei" & objSourceWb.Name
strTempPath = .FullName
.SendMail Recipients:=strRecipient, _
Subject:=strSubjectline
.Close SaveChanges:=False
Kill strTempPath
End With
Application.ScreenUpdating = True
End If
End If
SendEnd:
Set objNewWb = Nothing
Set objSourceWb = Nothing
Exit Sub
SendError:
MsgBox Prompt:="Fehler beim Senden der Datei " & _
"(" & Err.Number & "):" & vbCr & _
Err.Description
Resume SendEnd
End Sub
Dieses Makro auf eine Schaltfläche legen, oder sonst wie starten. Der Versand der Mail geht über Outlook.
Vielleicht hilfts
MfG