Hallo vielleicht kann mir hier jemand helfen stehe gerade etwas aufm Schlauch
Ich hab hier ein Makro welches aus einer Excel Mappe jede einzelne Tabelle per Mail an einen User versendet. Soweit klappt das auch..ich habe nur das Problem das der Name der Tabelle auch als solcher generiert werden sollte. Heraus kommt aber z.b. _ab3.xls _6c9.xls hier sollte aber stehen _vertreter1.xls _vertreter2.xls (Name des einzelnen Sheets) usw...wie kann man dies am einfachsten lösen ?
Hier der Code
Bedanke mich schon jetzt im voraus für Eure Hilfe.
Viele Grüße
Eddi
Ich hab hier ein Makro welches aus einer Excel Mappe jede einzelne Tabelle per Mail an einen User versendet. Soweit klappt das auch..ich habe nur das Problem das der Name der Tabelle auch als solcher generiert werden sollte. Heraus kommt aber z.b. _ab3.xls _6c9.xls hier sollte aber stehen _vertreter1.xls _vertreter2.xls (Name des einzelnen Sheets) usw...wie kann man dies am einfachsten lösen ?
Hier der Code
Code:
Sub Mail_versenden() 'Working in 97-2007 Dim sh As Worksheet Dim wb As Workbook Dim FileExtStr As String Dim FileFormatNum As Long Dim TempFilePath As String Dim TempFileName As String TempFilePath = Environ$("temp") & "\" If Val(Application.Version) < 12 Then 'You use Excel 97-2003 FileExtStr = ".xls": FileFormatNum = -4143 End If With Application .ScreenUpdating = False .EnableEvents = False End With For Each sh In ThisWorkbook.Worksheets If sh.Range("A1").Value Like "?*@?*.?*" Then sh.Copy Set wb = ActiveWorkbook TempFileName = "Sheet " & sh.Name & " of " _ & ThisWorkbook.Name & " " & Format(Now, "dd-mmm-yy h-mm-ss") With wb .SaveAs TempFilePath & TempFileName & FileExtStr, FileFormat:=FileFormatNum On Error Resume Next .SendMail sh.Range("A1").Value, _ "Aktuelle Umsätze" On Error GoTo 0 .Close SaveChanges:=True End With Kill TempFilePath & TempFileName & FileExtStr End If Next sh With Application .ScreenUpdating = True .EnableEvents = True End With End Sub
Viele Grüße
Eddi
Comment