Werte werden beim versenden nicht übernommen
02.08.2017 08:47:20
Torsten
ich habe ein Formular mittels Excel erstellt, dass per Mail versendet werden soll.
Die User sollen ihre Pflichtfelder eintragen und dann den Button zum versenden drücken.
Das Formular sollte zwischengespeichert werden, in die Mail gepackt und gesendet werden, aber die eingetragenen Werte werden nicht übernommen.
Das speichern funktioniert mit dem Makro, aber ich denke das er nicht das abgespeicherte Formular versendet......
Kann mir da jemand helfen?
hier mein Makro:
Sub Excel_Workbook_via_Outlook_Senden()
Application.DisplayAlerts = False
Worksheets.Application.ScreenUpdating = False
Dim MyMessage As Object, MyOutApp As Object
Dim Qe As Integer
Dim AWS As String
If IsEmpty(Range("B6").Value) = True Then
If IsEmpty(Range("D6").Value) = True Then
MsgBox ("Bitte tragen Sie die Kostenstelle oder die Auftragsnummer/Psp-Nummer ein")
Exit Sub
End If
End If
If Range("B9") = "" Then
MsgBox "Bitte geben Sie den Lagerort 1,2,3 oder Hygienelager ein!"
Exit Sub
End If
If Range("B24") = "" Then
MsgBox "Bitte geben Sie den Ablieferort ein!"
Exit Sub
End If
If Range("D24") = "" Then
MsgBox "Bitte geben Sie den Empfänger ein!"
Exit Sub
End If
If Range("B27") = "" Then
MsgBox "Bitte geben Sie das Datum ein!"
Exit Sub
End If
AWS = ThisWorkbook.FullName
Set MyOutApp = CreateObject("Outlook.Application")
Set MyMessage = MyOutApp.CreateItem(0)
strPfad = "Z:\"
strBlatt = ActiveSheet.Name
Sheets(strBlatt).Copy
ActiveWorkbook.SaveAs strPfad & "\" & "Auftrag_GK_Karte"
With MyMessage
If Range("B9") = "1" Then
.To = "........."
.Subject = "GK-Kartenanforderung " & Date & Time
.Attachments.Add AWS
.Body = "dies ist ein Test"
.Display
.Send
Else
If Range("B9") = "2" Then
.To = "........."
.Subject = "GK-Kartenanforderung " & Date & Time
.Attachments.Add AWS
.Body = "dies ist ein Test"
.Display
.Send
Else
If Range("B9") = "3" Then
.To = ".........."
.Subject = "GK-Kartenanforderung " & Date & Time
.Attachments.Add AWS
.Body = "dies ist ein Test"
.Display
.Send
Else
If Range("B9") = "Hygienelager" Then
.To = "..........."
.Subject = "GK-Kartenanforderung " & Date & Time
.Attachments.Add AWS
.Body = "dies ist ein Test"
.Display
.Send
Else
End If
End If
End If
End If
End With
MsgBox ("Ihre Mail wurde versendet")
Application.DisplayAlerts = True
Worksheets.Application.ScreenUpdating = True
Workbooks("Auftrag_GK_Karte.XLSX").Close
End Sub