VBA Gesicherte Mail erscheint "unsent"
27.11.2018 11:54:09
Arnd-Olav
ich habe ein MAcro, das bis zum 13.11. funktioniert hat. Mit diesem versende ich über ein Tabellenblatt Mails per Button an bestimmte Empfänger. Gleichzeitig wird die Mail auf dem Desktop in einem definierten Ordner gesichert.
Nun erscheinen seit dem 13.11. meine gesicherten gesendeten Mails, wenn ich sie wieder öffne als "ungesendet", ich könnte also den "Sende" Button erneut drücken.
Das ist unglücklich, da ich stellenweise diese Mails weiterleiten oder ähnliches muss.
Ich finde einfach nicht heraus, woran das liegt.
Hier ist der Code für ein und darunter der Code für die Userform.
Ich wäre sehr dankbar, wenn mir einer weiterhelfen kann. vielleicht liegt es ja auch an einem Update in Outlook? Keine Ahnung mehr :(
Sub mailtoxy()
Dim rng As Range
Dim OutApp As Object
Dim OutMail As Object
Dim oaccount As Object
Dim strfrom As String
Dim strto As String
Dim strcc As String
Dim strsl As String
Dim strbody As String, strbody1 As String, strbody2 As String, strbody3 As String, strbody4 As _
_
String
Dim SigString As String
Dim Signature As String
Dim filepath As String
'Prepare input for mail on sheet mail_templater
With Worksheets("mail_templater").Select
Range("d10:d20").Select '--- *** TO BE ADJUSTED *** ---
Selection.Copy
Range("C10").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:= _
_
False
End With
filepath = Sheets("UI").Range("B43")
Sheets("UI").Range("c43").Value = 0
strbody1 = Sheets("mail_templater").Range("c10")
strbody2 = Sheets("mail_templater").Range("c12")
strbody3 = Sheets("mail_templater").Range("c13")
strbody4 = Sheets("mail_templater").Range("c14")
strfrom = "procurement.aog@airbus.com"
strto = Sheets("UI").Range("B5") '--- *** TO BE ADJUSTED *** ---
strsl = Sheets("mail_templater").Range("c11")
'--- *** TO BE ADJUSTED *** ---
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
SigString = Environ("appdata") & "\Microsoft\Signatures\aog.htm"
If Dir(SigString) "" Then
Signature = GetBoiler(SigString)
Else
Signature = ""
End If
On Error Resume Next
With OutMail
.SentOnBehalfOfName = "procurement.aog@airbus.com"
.To = strto
.CC = ""
.BCC = ""
.Subject = strsl
.HTMLBody = "
" & strbody1 & "
" & Signature '--- *** TO BE ADJUSTED *** ---
.Display
End With
AppActivate Application.Caption
UserForm1.Show
If Sheets("UI").Range("c43").Value = 1 Then
Exit Sub
End If
emailname = Sheets("mail_templater").Range("b20")
With OutMail
.SaveAs filepath & emailname & ".msg"
.Send
End With
With Worksheets("mail_templater").Select
Range("b21").Select
Selection.Copy
End With
Sheets("UI").Select
Range("a1").Select
End Sub
Die Userform ist wie folgt:
Private Sub CommandButton1_Click()
TextBox1.Value = ""
End Sub
Private Sub CommandButton2_Click()
If TextBox1.Value = Empty Then
MsgBox ("Fast attach text empty"), , "Error"
Exit Sub
End If
Sheets("mail_templater").Range("B20") = TextBox1.Value
Me.Hide
End Sub
Private Sub CommandButton3_Click()
Sheets("UI").Range("C43").Value = "1"
Unload Me
End Sub
Private Sub Image1_Click()
End Sub
Private Sub UserForm_Activate()
TextBox1.Value = Sheets("mail_templater").Range("C20")
End Sub
Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
Sheets("UI").Range("C43").Value = "1"
End Sub