ich würde gern aus Excel ein E-Mail erzeugen. Habe im Forum dazu auch schon einen Code gefunden, der soweit auch nach meinen Wünschen funktioniert. Was mir aber noch fehlt ist, ich hätter gern das entweder der Bereich ("D5:At46") als Excel Dokument angehängt wird und den Namen aus Feld D7 erhält oder das eine vorher gespeicherte Datei angehängt wird (für das Speichern habe ich bereits einen Code), nur wie ich das zusammen bekomme, da komme ich leider nicht weiter.
Code zum Versenden:
Sub Excel_Serial_Mail()
Dim MyOutApp As Object, MyMessage As Object
Dim i As Long
' Dim ClpObj As DataObject
'Set VBEObj = Application.VBE.ActiveVBProject.References
'VBEObj.AddFromFile "MSPPT.OLB" 'das ist die Powerpoint Library
'VBEObj.AddfromFile "Std0le2.tlb"
'VBEObj.AddFromFile "Fm20.dll"
For i = 1 To 1
Set MyOutApp = CreateObject("Outlook.Application")
Set MyMessage = MyOutApp.CreateItem(0)
' Set ClpObj = New DataObject
' Range("D5:At46").Select
' Bereich wird in die Zwischenablage kopiert
' Selection.Copy
With MyMessage
'Die Empfänger stehen in Spalte A ab Zeile 1
.To = Cells(52, 6) 'E-Mail Adresse
.cc = Cells(53, 6) 'CC
.Subject = Cells(54, 6) 'Betreffzeile
.Body = Cells(56, 6) & vbCrLf & Cells(57, 6) & vbCrLf & Cells(58, 6)
& vbCrLf & Cells(59, 6) & vbCrLf & Cells(60, 6)
& vbCrLf & Cells(61, 6) & vbCrLf & Cells(62, 6)
& vbCrLf & Cells(63, 6) & vbCrLf & Cells(64, 6)
'Zwischenablage wird eingefügt
' ClpObj.GetFromClipboard
'.Body = ClpObj.GetText(1)
'Hier wird die Mail angezeigt
.Display
'Hier wird die Mail gleich in den Postausgang gelegt
'.Send
End With
'Objectvariablen leeren
Set MyOutApp = Nothing 'CreateObject("Outlook.Application")
Set MyMessage = Nothing 'MyOutApp.CreateItem(0)
'Sendepause einschalten
'Outlook kann die Aufträge nicht schnell genug verarbeiten
Application.Wait (Now + TimeValue("0:00:05"))
Next i
End Sub
Code zum Speichern:Sub Schaltfläche2_Klicken()
Dim strPath$, intFormat%, strName$, strExt$
strPath = "\\sstr102f.str.daimlerchrysler.com\estr_shr002\estr_te_sv\5 Abteilung\"
With ThisWorkbook
intFormat = .FileFormat 'Fileformat
strExt = Mid$(.Name, InStrRev(.Name, "."), Len(.Name)) 'Extension
strName = ActiveSheet.Name & "_" & Cells(7, 4) & strExt 'Name neue Datei
.ActiveSheet.Copy 'neue Datei erstellen durch kopieren
End With
With ActiveWorkbook
Range("A1:AU500").Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("A1:B500").Select
Selection.ClearContents
Range("e51:ar90").Select
Selection.ClearContents
Range("e51:ar90").Select
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorDark1
.TintAndShade = 0
.PatternTintAndShade = 0
End With
Range("A1").Select
.SaveAs strPath & strName, FileFormat:=intFormat
.Close 'schließen
End With
End Sub
Vielen herzlichen Dank.
Jens