Attachment Dateiendung

Hai Leute,
im folgenden Code wird ein Workbook als Attachment versandt.
Nun wir ja bei savepath der Name vergeben, mein Problem:
Der Empfänger bekommt nun ein Workbook das *.xls.xls heißt soll heißen es wird der Workbookname mit .xls ausgelesen und wahrscheinlich das Format zusätzlich nochmals mit .xls!
Wie krieg ich das hin, dass das passt? (Workbookname mit einfacher Dateiendung)


Sub DruckSenden()
Dim outObj As Object
Dim Mail As Object
Dim i As Integer
Dim savepath As String
Dim savename As String
Application.DisplayAlerts = False
'Tabelle drucken
ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True
'Tabelle versenden
savepath = "c:\temp\" & ActiveWorkbook.Name & ".xls"
On Error Resume Next
Kill savepath
ActiveWorkbook.ActiveSheet.Copy
ActiveWorkbook.SaveAs savepath
ActiveWorkbook.Close savechanges:=False
Set outObj = CreateObject("Outlook.Application")
Set Mail = outObj.CreateItem(0)
With Mail
.Subject = Range("A1").Value & " " & Range("D1").Value & " " & Range("E1").Value
.Body = "Hallo" & vbLf & _
"hier die neueste Auslastungsliste" & vbLf & _
"Viele Grüße " & vbLf & _
Application.UserName
.To = "123@abc.de"
'.CC = Sheets("Tabelle1").Cells(3, 2).Value
'.Bcc = Sheets("Tabelle1").Cells(4, 2).Value
End With
With Application.FileSearch
.NewSearch
.LookIn = savepath
.SearchSubFolders = False
.FileType = msoFileTypeAllFiles
.Execute
Mail.Attachments.Add savepath
End With
Mail.send
Set Mail = Nothing
Set outObj = Nothing
'Excel (Workbook) schließen
If Workbooks.Count = 1 Then
ThisWorkbook.Saved = True
Application.Quit
Else
ThisWorkbook.Close False
End If
Application.DisplayAlerts = True
End Sub

Danke mal, Gruss volker

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Hallo

Vielleicht hilft dir das weiter. Glaube aber, die Datei muß vorher gespeichert werden.

Sub Email_aus_Excel_mit_Outlook_2()
Dim EmailEmpfänger  As String
Dim EmailBetreff    As String
Dim EmailAnhang     As String

Dim olMailItem
Dim MailItem
Dim myOlApp
Dim myRecipient
Dim myAttachments

EmailEmpfänger = "gra.fri@aon.at"  '"grath.fritz@aon.at"
EmailBetreff = "Wochenbericht.xls"
EmailAnhang = "C:\Temp\Test.xls"    'ThisWorkbook.Path & ThisWorkbook.Name

'Outlook wird geöffnet
    Set myOlApp = CreateObject("Outlook.Application")
'Fenster für neue Mail wird geöffnet
    Set MailItem = myOlApp.CreateItem(olMailItem) ' opens new email

On Error GoTo ErrorHandler
'       Empfänger der Mail wird in das Adressfeld "An:" geschrieben
        Set myRecipient = MailItem.Recipients.Add(EmailEmpfänger)

'       Betreff der Mail wird in das Feld "Betreff:" geschrieben
        MailItem.Subject = EmailBetreff

'       Anlage wird angehängt
        Set myAttachments = MailItem.attachments.Add(EmailAnhang)

'       Email wird gesendet
        MailItem.Send

'   Outlook wird geschlossen und das Makro nach einer Pause
'   von 2 Sekunden fortgesetzt >> um Ressourcenprobleme zu vermeiden.
    myOlApp.Quit
    Application.Wait (Now + TimeValue("0:00:02"))
    Exit Sub

ErrorHandler:
    MsgBox vbTab & "Eine E-Mail an die Adresse " & vbCrLf & vbCrLf & _
    vbTab & EmailEmpfänger & vbCrLf & vbCrLf & _
    "kann leider NICHT automatisch versendet werden."
End Sub

Code eingefügt mit Syntaxhighlighter 2.4

mfg, GraFri

Beliebteste Forumthreads (12 Monate)

4 Beiträge zum Forumthread Beiträge zu diesem Forumthread

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

4
Beiträge zum Forumthread

Beiträge zu diesem Forumthread