AW: text box e -mail
05.12.2008 15:12:00
mumpel
Hallo!
Hier mal ein Auszu aus meinem Projekt.
Private Sub Label8_Click()
Dim empfänger As String
Dim Kopie As String
Dim Blindkopie As String
Dim aws As String
Dim olapp As Object
Blindkopie = TextBox6.text
Kopie = TextBox5.text
empfänger = TextBox1.text
If OptionButton3.Value = True Then
Dim rng As Range
Set olapp = CreateObject("Outlook.Application")
With olapp.CreateItem(0)
Set rng = Selection
.To = empfänger
.CC = Kopie
.BCC = Blindkopie
.Subject = TextBox2.text
.htmlBody = TextBox3.Value & vbCrLf & vbCrLf & vbCrLf & RangetoHTML(rng)
If CheckBox1.Value = True Then .ReadReceiptRequested = True
.Display
If CheckBox2.Value = True Then SendKeys "%s", True
Set rng = Nothing
Set olapp = Nothing
End With
Unload Me
ElseIf OptionButton1.Value = True Then
Application.DisplayAlerts = False
If OptionButton4.Value = True Then ActiveWorkbook.Save
If OptionButton5.Value = True Then ActiveWorkbook.SaveAs ActiveWorkbook.FullName & ".xls"
aws = ActiveWorkbook.FullName
Set olapp = CreateObject("Outlook.Application")
With olapp.CreateItem(0)
.To = empfänger
.CC = Kopie
.BCC = Blindkopie
.Subject = TextBox2.text
.htmlBody = TextBox3.text
If CheckBox1.Value = True Then .ReadReceiptRequested = True
.Attachments.Add aws
.Display
If CheckBox2.Value = True Then SendKeys "%s", True
Set olapp = Nothing
Application.DisplayAlerts = True
End With
Unload Me
ElseIf OptionButton2.Value = True Then
Application.DisplayAlerts = False
ActiveWorkbook.ActiveSheet.Copy
If OptionButton4.Value = True Then ActiveWorkbook.SaveAs TextBox4.Value & ".xlsx"
If OptionButton5.Value = True Then ActiveWorkbook.SaveAs TextBox4.text & ".xls"
aws = ActiveWorkbook.FullName
Set olapp = CreateObject("Outlook.Application")
With olapp.CreateItem(0)
.To = empfänger
.CC = Kopie
.BCC = Blindkopie
.Subject = TextBox2.text
.htmlBody = TextBox3.text
If CheckBox1.Value = True Then .ReadReceiptRequested = True
.Attachments.Add aws
.Display
If CheckBox2.Value = True Then SendKeys "%s", True
Set olapp = Nothing
Application.DisplayAlerts = True
Unload Me
End With
Else
MsgBox "Sie müssen erst eine Auswahl treffen!", vbOKOnly + vbExclamation, "Hinweis"
End If
End Sub
Code eingefügt mit VBA in HTML 2.0size>
Das Projekt selber: Office Telefon- und Mailfunktion
Gruß, René