AW: VBA speichern und schliessen
25.08.2018 09:48:52
Marquardt
Zur Erklärung noch.
0 Prüfung auf leere Felder
1 Umwandung in Pdf
2 Es wird eine Mail geöffnet. Alle Eintragungen werden aus der Tabelle geholt.
3 Hinweis was als Anlage hinzugefügt werden muss
4 Dann können die Anlagen ausgewählt werden.
5 Jetzt soll gespeichert und geschlossen werden.
(Die Signatur muss erhalten bleiben)
[pre]
Sub ExcelabnahmeprotokollLadenbau()
Dim chkRange As Range, myC As Range
Dim msg As String
'Hier die Zellen eintragen die geprüft werden sollen
Set chkRange = Sheets("Abnahme").Range("A6,A8,d10,B6,g3,e260")
'Ab hier nichts mehr ändern
msg = ""
For Each myC In chkRange
If IsEmpty(myC) Then
msg = msg & myC.Address & vbCrLf
End If
Next
If msg = "" Then
Else
MsgBox "Folgende Zellen sind leer:" & Chr(13) & vbCrLf & msg, vbInformation + vbOKOnly, "Prü _
fergebnis"
Exit Sub
End If
ChDir ThisWorkbook.Path 'anpassen 'oder thisworkbook.path
Sheets("Abnahme").ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
ThisWorkbook.Path & "\" & Sheets("Abnahme").Range("T1").Value & ".pdf", Quality:= _
xlQualityStandard, _
IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:= _
False
Dim objOutlook As Object
Dim objMail As Object
Set objOutlook = CreateObject("Outlook.Application")
Set objMail = objOutlook.createItem(0)
With objMail
.GetInspector ' sorgt für die Signatur
.To = Sheets("Abnahme").Range("S3").Value
.CC = Sheets("Abnahme").Range("t4").Value
.BCC = Sheets("Abnahme").Range("t5").Value
.Subject = ThisWorkbook.Worksheets("Abnahme").Range("T1")
.body = Sheets("Abnahme").Range("T2").Value & .body
.Display 'Erstellt die Email und öffnet diese. Der Versand erfolgt anschließend _
manuell vom User!
MsgBox ("ACHTUNG!" & Chr(13) & Chr(13) & "Fügen Sie folgende Anlage an:" & Chr(13) & Chr(13) _
& "- die Datei mit dem Namen:" & Chr(13) & Chr(13) & " " & Sheets("Abnahme").Range("t1") & ".pdf" & Chr(13) & Chr(13) & "- die Bilder* für " & Sheets("Abnahme").Range("f255") & " Mängelpunkte (1,2,3, usw.)" & Chr(13) & " *Die Bilder sind im Formular aufsteigend durchnummeriert!)" & Chr(13) & Chr(13) & "Bitte die zu sendende(n) Datei(en) auswählen!"), vbInformation, "Bestandsmanagement der Objektverwaltung Ponholz"
Set fdOpen = Application.FileDialog(msoFileDialogOpen)
With fdOpen
.AllowMultiSelect = True
.InitialView = msoFileDialogViewList
.InitialFileName = ActiveWorkbook.Path
.Title = "Bitte die zu sendende(n) Datei(en) auswählen!"
.ButtonName = "als Anlage zur E-Mail senden"
If .Show = True Then
Dim i As Integer
If .SelectedItems.Count > 0 Then
For i = 1 To .SelectedItems.Count
objMail.attachments.Add .SelectedItems(i)
Next
End If
End If
If ThisWorkbook.Saved = False Then
Antwort = MsgBox("Die Datei wird jetzt gespeichert und zusammen mit dem Programm _
geschlossen!" & Chr(13) & Chr(13) & "Bitte vergessen Sie nicht, die erzeugte Mail auf Richtigkeit zu prüfen und zu versenden." & Chr(13) & Chr(13) & "Vielen Dank!", vbInformation + vbOKOnly, "Bestandsmanagement der Objektverwaltung Ponholz")
If Antwort = vbOK Then
ThisWorkbook.Save
ThisWorkbook.Close
End If
End If
End With
End With
SendKeys body
End Sub
[\pre]