Hier nochmal mein Code. Bis auf das eigentliche Versenden der Mail ist es getestet. Der Mailversand kann bei mir nicht getestet werden, weil ich kein Outlook verwende. Vorausetzung: Zwei VommandButtons mit dem Namen (NICHT Caption) CommandButton1 und CommandButton2. Wenn die Buttons andere Namen haben, muß die jeweilige Prozedur von "CommanButtonx_Click()" in "Name_Click()" geändert werden. Der letzte von Dir genannte Fehler beruht auf einer bei Dir fehlenden Deklaration der Variablen "Start". Bei mir ist sie deklariert. Wieso die Deklaration nicht mit übertragen wurde ist mir schleierhaft.
Option Explicit
Private Sub CommandButton1_Click()
Dim strEmailAdr As String
strEmailAdr = InputBox("Emailadresse des Empfängers eingeben:", "Mailadresse")
If InStr(1, strEmailAdr, "@", vbBinaryCompare) = 0 Or InStr(1, strEmailAdr, ".", vbBinaryCompare) = 0 Then
MsgBox """" & strEmailAdr & """ ist keine Emailadresse!" & Chr(10) _
& "Geben Sie eine gültige Emailadresse ein!", vbCritical, "Abbruch..."
Exit Sub
End If
'Wenn auf diesem CodeModule vor der (jetzigen) Zeile 33: strEmailAdr = "" Code eingefügt wird muß in der folgenden
'Zeile die Zeilennummer 33 bei .ReplaceLine = 33 angepaßt werden!
ThisDocument.VBProject.VBComponents("ThisDocument").CodeModule.ReplaceLine 33, "strEmailAdr = """ & strEmailAdr & """"
ThisDocument.VBProject.VBComponents("ThisDocument").CodeModule.DeleteLines 2, 23
With ThisDocument.CommandButton1
.Width = 0
.Height = 0
.ForeColor = &HFFFFFF
.BackColor = &HFFFFFF
.Enabled = False
End With
ThisDocument.Protect wdAllowOnlyReading, , strEmailAdr
ThisDocument.Save
End Sub
Private Sub CommandButton2_Click()
'Es muß ein Verweis auf das "Microsoft Outlook nn.n Object Library" gesetzt sein!
Dim olApp As Outlook.Application
Dim olMail As Outlook.MailItem
Dim olRun As Boolean
Dim strEmailAdr As String
Dim Start As Single
strEmailAdr = ""
On Error Resume Next
If strEmailAdr = "" Then
MsgBox "Wegen fehlender Emailadresse kann keine Antwortmail versandt werden!", vbCritical, "Abbruch..."
Exit Sub
End If
olRun = True
Set olApp = GetObject(, "Outlook.Application")
If Err.Number <> 0 Then
Err.Clear
Set olApp = CreateObject("Outlook.Application"): DoEvents
Start = Timer
While Timer < Start + 5
DoEvents
Wend
olRun = False
End If
Set olMail = olApp.CreateItem(0)
With olMail
'Die Angaben für "Subject" und "body" müssen natürlich angepaßt werden!
.Recipients.Add strEmailAdr
.Subject = "Rückmeldung"
.body = "Ihre Mail bezüglich der ausstehenden Lieferung ist hier eingegangen und wurde bearbeitet."
.send
End With
Set olMail = Nothing
If olRun = False Then
olApp.Quit: DoEvents
Start = Timer
While Timer < Start + 5
DoEvents
Wend
End If
Set olApp = Nothing
End Sub
|