Anzeige
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender

Forumthread: Per Textbox Eingabe in Mailbody!

Per Textbox Eingabe in Mailbody!
01.09.2006 09:43:30
Krutzler
Hallo, ihr Profis!
Ich habe eine Datei, die ich über VBA automatisch per Mail versende. Nun will ich aber, ehe die Mail auf die Reise geht, noch einen zusätzlichen Text in den Mailbody eingeben können.
Hier mal der Versand:
ActiveWorkbook.Save
AWS = ActiveWorkbook.FullName
Set olApp = CreateObject("Outlook.Application")
With olApp.CreateItem(0) ' Neue Mail erstellen
.display ' Mail anzeigen
.Recipients.Add "name@dingsbums.com"
.Subject = "Test" ' Betreff setzen
strSig = .body
.body = "TEST" & vbr & strSig
.ReadReceiptRequested = True ' Rückmeldung senden
.Attachments.Add AWS
.Send ' Mail senden
End With
Bitte helfen - Danke!
lg Andreas
Anzeige

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

Betreff
Datum
Anwender
Anzeige
AW: Per Textbox Eingabe in Mailbody!
01.09.2006 11:10:55
mumpel
Hallo!
Das geht über eine Userform. Schau Dir hierzu mal die folgende Arbeitsmappe an.
https://www.herber.de/bbs/user/36333.xls
Gruss, Rene
AW: Per Textbox Eingabe in Mailbody!
01.09.2006 12:00:02
Krutzler
Hallo Rene!
Liest sich gut und funktioniert auch perfekt in Deiner Arbeitsmappe, aber wo bitte bau ich das in meinem VBA ein:

Sub FWLtg3()
' FWLtg3 Makro
' Makro am 21.08.2006 von akru aufgezeichnet
Sheets("Berechnung").Select
Range("A1:CQ3000").Select
Selection.Copy
Workbooks.Open Filename:= _
"C:\Wartung.xls"
Range("AH1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Range("A1").Select
Application.CutCopyMode = False
Range("AJ:AQ,BH:DX").Select
Range("AJ1").Activate
Selection.Replace What:="0", Replacement:="", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
Range("A1").Select
ActiveWorkbook.Save
Windows("AlleFil.xls").Activate
Sheets("Berechnung").Select
Selection.Copy
Workbooks.Open Filename:= _
"C:\AllFil.xls"
Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Range("A1").Select
Application.CutCopyMode = False
Range("C:J,AA:CQ").Select
Range("AA1").Activate
Selection.Replace What:="0", Replacement:="", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
Range("A1").Select
ActiveWorkbook.Save
AWS = ActiveWorkbook.FullName
Set olApp = CreateObject("Outlook.Application")
With olApp.CreateItem(0) ' Neue Mail erstellen
.display ' Mail anzeigen
.Recipients.Add "dings@dings.at"
.Subject = "Aktuelle AllFil vom " & Date ' Betreff setzen
strSig = .body
.body = "Die neue AlleFil" & vbr & strSig
.ReadReceiptRequested = True ' Rückmeldung senden
.Attachments.Add AWS
.Send ' Mail senden
End With
Windows("AllFil.xls").Activate
Range("A1").Select
ActiveWorkbook.Close
Windows("AlleFil.xls").Activate
Range("A1").Select
ActiveWorkbook.Close
End Sub

Anzeige
AW: Per Textbox Eingabe in Mailbody!
01.09.2006 12:18:24
mumpel
Hallo!
Zeichne zuerst die Userform, wie Du sie in der Beispielmappe siehst. Füge dann den folgenden Code (alle drei) "hinter" Deiner Userform ein.

Private Sub CommandButton1_Click()
Unload Me
End Sub


Private Sub CommandButton2_Click()
On Error Resume Next
Dim empfänger As String
Dim texte As String
Dim betreff As String
empfänger = TextBox1.Text
betreff = TextBox2.Text
texte = TextBox3.Text
ActiveWorkbook.Save
AWS = ActiveWorkbook.FullName
Set olApp = CreateObject("Outlook.Application")
With olApp.CreateItem(0) ' Neue Mail erstellen
.display ' Mail anzeigen
.Recipients.Add TextBox1.Text
.Subject = TextBox2.Text
strSig = .body
.body = TextBox3.Text & vbr & strSig
.ReadReceiptRequested = True ' Rückmeldung senden
.Attachments.Add AWS
.Send ' Mail senden
End With
Unload Me
Windows("AllFil.xls").Activate
Range("A1").Select
ActiveWorkbook.Close
Windows("AlleFil.xls").Activate
Range("A1").Select
ActiveWorkbook.Close
End Sub


Private Sub UserForm_Initialize()
TextBox1.Text = "name@dingsbums.de"
TextBox2.Text = "Aktuelle Mappe vom " & Date
End Sub

Anschließend änderst Du das Makro "FWLtg3" wie folgt.
Sub FWLtg3()
Sheets("Berechnung").Select
Range("A1:CQ3000").Select
Selection.Copy
Workbooks.Open Filename:= _
"C:\Wartung.xls"
Range("AH1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Range("A1").Select
Application.CutCopyMode = False
Range("AJ:AQ,BH:DX").Select
Range("AJ1").Activate
Selection.Replace What:="0", Replacement:="", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
Range("A1").Select
ActiveWorkbook.Save
Windows("AlleFil.xls").Activate
Sheets("Berechnung").Select
Selection.Copy
Workbooks.Open Filename:= _
"C:\AllFil.xls"
Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Range("A1").Select
Application.CutCopyMode = False
Range("C:J,AA:CQ").Select
Range("AA1").Activate
Selection.Replace What:="0", Replacement:="", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
Range("A1").Select
ActiveWorkbook.Save
Userform1.Show
End Sub
Gruß, Rene
Anzeige
AW: Per Textbox Eingabe in Mailbody!
01.09.2006 13:51:12
Krutzler
Perfekt!
Vielen, vielen Dank!
lg Andreas
;

Forumthreads zu verwandten Themen

Anzeige
Anzeige
Anzeige
Anzeige
Entdecke relevante Threads

Schau dir verwandte Threads basierend auf dem aktuellen Thema an

Alle relevanten Threads mit Inhaltsvorschau entdecken
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Entdecke mehr
Finde genau, was du suchst

Die erweiterte Suchfunktion hilft dir, gezielt die besten Antworten zu finden

Suche nach den besten Antworten
Unsere beliebtesten Threads

Entdecke unsere meistgeklickten Beiträge in der Google Suche

Top 100 Threads jetzt ansehen
Anzeige