Makro Mail Hilfe Bitte Dringend:)
26.07.2013 09:40:36
Sandy
Aus irgend einem Grund spinnt meine Makro seit ich die Signatur rein gebracht habe. Die Excel versendet sich selbst per Email an die in der Excel eingestellten Daten per knopfdruck.
Aber jetzt hängt die Datei anstatt zwischen Text und Signatur
Irgendwo unten in einen der letzten Zeilen der Signatur:( bis grad vorhin gings noch und ich muss das Projekt morgen fertig habe.
Hilfe bitte.
Sub Excel_Workbook_via_Outlook_Senden()
Dim MyMessage As Object, MyOutApp As Object
Dim Qe As Integer
Dim AWS As String
'Testen ob die aktuelle Mappe schon gespeichert wurde
If ThisWorkbook.Saved = False Then
'Die letzten Änderungen wurden noch nicht gespeichert
Qe = MsgBox("Diese Mappe wurde noch nicht gespeichert, und kann nicht versandt werden!" _
& Chr$(13) & "Soll die Datei gespeichert werden?", vbInformation + vbYesNo, "Sendefehler")
If Qe = vbNo Then
'Abbruch durch Benutzer
MsgBox "Sendevorgang abgebrochen"
Exit Sub
Else
'Prüfen ob die Datei schon mal gespeichert wurde
If Right(ThisWorkbook.Name, 3) "xls" Then
'Nein > Speicherdialog aufrufen
Application.Dialogs(xlDialogSaveAs).Show
Else
'Speichern
ThisWorkbook.Save
End If
End If
End If
'Aktive Arbeitsmappe wird als mail gesendet
'Übergabe des Mappennames an die Variable
AWS = ThisWorkbook.FullName
'Outlook Object erstellen
Set MyOutApp = CreateObject("Outlook.Application")
'Outlook Nachricht erstellen
Set MyMessage = MyOutApp.CreateItem(0)
With MyMessage
Dim sEmpfaenger As String, sBetreff As String, sBodyHeader As String, sBodyFooter As String
sEmpfaenger = ThisWorkbook.Sheets("Daten").Range("Y2").Value & ";" & _
ThisWorkbook.Sheets("Daten").Range("Y3").Value & ";" & _
ThisWorkbook.Sheets("Daten").Range("Y4").Value
sBetreff = ThisWorkbook.Sheets("Daten").Range("Y8").Value
'Empfänger
.To = sEmpfaenger
'Betreff
.Subject = sBetreff
.Attachments.Add AWS
'Hier wird ein normaler Text erstellt
sBodyHeader = ThisWorkbook.Sheets("Daten").Range("Y16").Value.ColorIndex = 5 & vbCrLf & _
ThisWorkbook.Sheets("Daten").Range("Y11").Value & " " & _
ThisWorkbook.Sheets("Daten").Range("Y22").Value & " " & _
ThisWorkbook.Sheets("Daten").Range("Y21").Value & vbCrLf & _
ThisWorkbook.Sheets("Daten").Range("Y12").Value & vbCrLf & _
ThisWorkbook.Sheets("Daten").Range("Y13").Value & vbCrLf & _
ThisWorkbook.Sheets("Daten").Range("Y14").Value & vbCrLf & vbCrLf & vbCrLf & vbCrLf
sBodyFooter = ThisWorkbook.Sheets("Daten").Range("AE44").Value & vbCrLf & _
ThisWorkbook.Sheets("Daten").Range("AE45").Value & vbCrLf & vbCrLf & vbCrLf & _
ThisWorkbook.Sheets("Daten").Range("AE48").Value & vbCrLf & _
ThisWorkbook.Sheets("Daten").Range("AE49").Value & vbCrLf & _
ThisWorkbook.Sheets("Daten").Range("AE50").Value & vbCrLf & _
ThisWorkbook.Sheets("Daten").Range("AE51").Value & vbCrLf & _
ThisWorkbook.Sheets("Daten").Range("AF52").Value & " " & _
ThisWorkbook.Sheets("Daten").Range("AE52").Value & vbCrLf & _
ThisWorkbook.Sheets("Daten").Range("AE53").Value & _
ThisWorkbook.Sheets("Daten").Range("AE54").Value & vbCrLf & _
ThisWorkbook.Sheets("Daten").Range("AE55").Value & vbCrLf & vbCrLf & _
ThisWorkbook.Sheets("Daten").Range("AE57").Value & vbCrLf & vbCrLf & _
ThisWorkbook.Sheets("Daten").Range("AE59").Value & vbCrLf & _
ThisWorkbook.Sheets("Daten").Range("AE60").Value & vbCrLf & _
ThisWorkbook.Sheets("Daten").Range("AE61").Value & vbCrLf & _
ThisWorkbook.Sheets("Daten").Range("AE62").Value & vbCrLf & _
ThisWorkbook.Sheets("Daten").Range("AE63").Value & vbCrLf & _
ThisWorkbook.Sheets("Daten").Range("AE64").Value & vbCrLf & _
ThisWorkbook.Sheets("Daten").Range("AE65").Value & vbCrLf & vbCrLf & _
ThisWorkbook.Sheets("Daten").Range("AE67").Value
.Body = sBodyHeader & sBodyFooter
'Hier wird eine HTML Mail erstellt
'Dies kann zu Problemen führen, wenn der Empfänger
'nur TEXT Dateien empfangen darf.
'.HTMLBody = "Das ist ein Test." & vbCrLf & "Bitte ignorieren."
'Hier wird die Mail nochmals angezeigt
.Display
'Hier wird die Mail gleich in den Postausgang gelegt und gesendet
'.Send
End With
'Variablen leeren
Set MyOutApp = Nothing
Set MyMessage = Nothing
End Sub
Hier die Makro