Gruppe
Extern
Problem
Wie kann ich den Inhalt einer Excel-Tabelle in ein Worddokument einfügen und dieses automatisch per Email versenden?
StandardModule: basMain
Sub SendMessage()
Dim oWord As Object
Dim oDoc As Object
Dim oOL As Object
Dim oOLMsg As Object
Dim oOLRecip As Object
Dim oOLAttach As Object
Dim iRow As Integer
Dim sFile As String
sFile = Application.Path & "\test.doc"
ThisWorkbook.Worksheets("Tabelle2").UsedRange.Copy
Set oWord = CreateObject("Word.Application")
Set oDoc = oWord.Documents.Add
oDoc.Range.Paste
oDoc.SaveAs sFile
oWord.Quit
Set oDoc = Nothing
Set oWord = Nothing
Set oOL = CreateObject("Outlook.Application")
Set oOLMsg = oOL.CreateItem(0)
With oOLMsg
iRow = 1
Do Until IsEmpty(Cells(iRow, 1))
Set oOLRecip = .Recipients.Add(Cells(iRow, 1))
oOLRecip.Type = 1
iRow = iRow + 1
Loop
Set oOLAttach = .Attachments.Add(sFile)
.Subject = Format(Date, "dd.mm.yy") & " - " & Format(Time, "hh:mm:ss")
.Body = "Beiliegend der Excel-Text"
.Importance = 1
For Each oOLRecip In .Recipients
oOLRecip.Resolve
Next
.Send
End With
Set oOL = Nothing
End Sub