Anhang Tabellenblatt_outlook/ XP/Win2000
20.10.2004 12:41:44
subsiro
habe dank des Forums mir einen Code zusammengestrickt der auch funktioniert.
Mit einem Unterschied:
Bei Win XP und Office 2002 wird das Tabellenblatt direkt eins tiefer unter der Betreffzeile als Anhang eingefügt, also so wie immer als würde man von Hand über einfügen eine Datei anhängen.
Bei Win 2000 und Office 2000 wird das Tabellenblatt auch angehangen, aber unter dem Body-Text.
Also wird der Anhang unter dem Text M.Mustermann eingefügt...
Kann mir jemand erklären woran das liegt?An der Office Version?
Oder fehlt in dem Code, wenn es für die Office 2000 Version genauso funktionieren soll, ein VBA Befehl?
Danke für Eure Hilfe...
Gruß Subsiro
Sub Outlook_Zellbereich_kopieren_und_versenden()
Dim OutApp As Outlook.Application
Dim OutMail As Outlook.MailItem
Dim source As Range
Dim dest As Workbook
Dim strdate As String
Set source = Range("A1:W100").SpecialCells(xlCellTypeVisible)
Set OutApp = CreateObject("Outlook.Application")
For Each ws In ThisWorkbook.Worksheets
If ws.Range("g13").Value Like "*@*" Then
strdate = Format(Now, "dd.mm.yyyy")
Application.ScreenUpdating = False
Set dest = Workbooks.Add(xlWBATWorksheet)
source.Copy
With dest.Sheets(1)
.Cells(1).PasteSpecial Paste:=8
' Paste:=8 will copy the column width in Excel 2000 and higher
' If you use Excel 97 use the other example
.Cells(1).PasteSpecial xlPasteValues, , False, False
.Cells(1).PasteSpecial xlPasteFormats, , False, False
.Cells(1).Select
Application.CutCopyMode = False
End With
With dest
.SaveAs "Bestellung " & " " & strdate & ".xls"
Set OutMail = OutApp.CreateItem(olMailItem)
With OutMail
.To = ws.Range("g13").Value
.CC = ""
.BCC = ""
.Subject = "Bestellung"
.Body = "Sehr geehrte Damen und Herren," & vbNewLine & vbNewLine & _
"bitte führen Sie die Bestellung wie im Anhang beschrieben aus!" & vbNewLine & _
"" & vbNewLine & _
"Mit freundlichen Grüßen" & vbNewLine & _
"M.Mustermann" & vbNewLine & _
"" & vbNewLine & _
"" & vbNewLine & _
.Attachments.Add dest.FullName
.Send
End With
.ChangeFileAccess xlReadOnly
Kill .FullName
.Close False
End With
Set OutMail = Nothing
End If
Next ws
Set OutApp = Nothing
Application.ScreenUpdating = True
End Sub