|
Hi,
ich weiße auch nicht warum es bei mir nicht funktioniert. Bin echt verzweifelt. Wenn ich Button1 ausführe, nach der Email-Eingabe bekomme ich immer diese Meldung: Laufzeitfehler 4198: Befehl misslungen.
Danach führe ich Button 2: Fehlermeldung: Variable nicht definiert : Zeile 43 der Ausdruck Start= wird markiert. Echt komisch.
Ich schicke dir meine Code. Kannst du einen Blick reinwerfen:
Option Explicit '1
'2
Private Sub CommandButton1_Click() '3
Dim strEmailAdr As String '4
strEmailAdr = InputBox("Emailadresse des Empfängers eingeben:", "Mailadresse") '5
If InStr(1, strEmailAdr, "@", vbBinaryCompare) = 0 Or InStr(1, strEmailAdr, ".", vbBinaryCompare) = 0 Then '6
MsgBox """" & strEmailAdr & """ ist keine Emailadresse!" & Chr(10) _ '7
& "Geben Sie eine gültige Emailadresse ein!", vbCritical, "Abbruch..." '8
Exit Sub '9
End If '10
'Wenn auf diesem CodeModule vor der (jetzigen) Zeile 32: strEmailAdr = "" Code eingefügt wird muß in der folgenden '11
'Zeile die Zeilennummer 32 bei .ReplaceLine = 32 angepaßt werden! '12
ThisDocument.VBProject.VBComponents("ThisDocument").CodeModule.ReplaceLine 32, "strEmailAdr = """ & strEmailAdr & """" '13
ThisDocument.VBProject.VBComponents("ThisDocument").CodeModule.DeleteLines 2, 23 '14
With ThisDocument.CommandButton1 '15
.Width = 0 '16
.Height = 0 '17
.ForeColor = 2 '18
.BackColor = 2 '19
.Enabled = False '20
End With '21
ThisDocument.Protect wdAllowOnlyReading, True, strEmailAdr '22
ThisDocument.Save '23
End Sub '24
'25
Private Sub CommandButton2_Click() '26
'Es muß ein Verweis auf das "Microsoft Outlook nn.n Object Library" gesetzt sein! '27
Dim olApp As Outlook.Application '28
Dim olMail As Outlook.MailItem '29
Dim olRun As Boolean '30
Dim strEmailAdr As String '31
strEmailAdr = "" '32
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 '43
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 = ThisDocument.FormFields("Neal").Result
.body = ThisDocument.FormFields("Subject").Result & Chr(13) & ThisDocument.FormFields("Description").Result
.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
Danke
|