Aktuelles Blatt versenden

Forumthread: Aktuelles Blatt versenden

08.02.2020 19:38:03

Uli

Hallo Zusammen,
habe ein Exceldatei die ich per Button als Mail versende.
Hier wird die Datei" Übergabe Frühschicht_MB" mit eingefügt.
Es liegt noch eine Excel Datei in einem anderen Verzeichnis,welche einzelne Blätter hat die nach den Kalenderwochen benannt sind. Also KW01-KW02 u.s.w.
Ich würde gerne das Blatt der Aktuellen Kalenderwoche auch mit mit der Mail versenden. Und nicht immer die ganze Datei .
Eventuell kann mir jemand helfen .
Danke schön.
Sub Mail_senden_Frühschicht()
If MsgBox("Du möchtest das Protokoll absenden und speichern?", vbYesNo) = vbYes Then
Dim rng As Range
Dim olApplication As Object
Dim objEMail As Object
Set olApplication = CreateObject("Outlook.Application")
Set objEMail = olApplication.CreateItem(olMailItem)
With objEMail
Set rng = Sheets("Frühschicht").Range("A1:H49")
.To = "XXXXXXXXXXXXXX"
.Subject = "Übergabe Frühschicht_MB"
.HTMLBody = RangetoHTML(rng)
.Send
End With

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

AW: Aktuelles Blatt versenden

08.02.2020 20:11:45

Uli

Danke für die Antwort. Hilft mir nur nicht so richtig weiter. Die Datei in der das Blatt mit der KW ist ,ist geschlossen.Also müsste das Aktuelle KW Blatt aus der DAtei ausgelesen werden und versendet.
Gruß Uli

AW: Aktuelles Blatt versenden

08.02.2020 20:31:49

Chris

Hallo Uli,
Ich würde mir die zweite Datei mittels VBA öffnen und mir das Gewünschte Tabellenblatt anhand vom Datum(KW) in die Übergabe Frühschicht MB als neues Blatt einfügen und die Datei dann versenden.
ein Code auf die schnelle habe ich nicht zur Hand, da müsste ich erst basteln und nachstellen aber vielleicht Hilft dir der Ansatz schon.
LG Chris

AW: Aktuelles Blatt versenden

09.02.2020 07:39:51

Uli

Hallo
Danke für die Antwort,doch die Antwort, stellt meine Frage ja nochmal sozusagen .

AW: Aktuelles Blatt versenden

09.02.2020 12:30:59

Uli

Hallo
Mit dem Befehl .Attachments.Add und dem Pfad sendet er die Datei. Welchen Befehl kann ich hinzufügen damit der sich aus der Datei "OEE_Tagesdurchschnitt.xlsx" mur das Blatt mit der Aktuellen KW holt und versendet ?
Danke
With objEMail
Set rng = Sheets("Frühschicht").Range("A1:J70")
.To = "xxxxxxxxxxxxxx"
.Subject = "Übergabe Frühschicht_MB"
.HTMLBody = RangetoHTML(rng)
.Attachments.Add "T:\Montage\Focus Factory_Tagesdurchschnitt OEE\OEE_Tagesdurchschnitt.xlsx" _

AW: Aktuelles Blatt versenden

09.02.2020 13:00:12

Nepumuk

Hallo Uli,
ich bin jetzt mal davon ausgegangen dass das aktuelle Blatt "KW06" heißt.

Option Explicit

Public Sub Mail_senden_Fruehschicht()

    Dim rng As Range
    Dim objWorkbook As Workbook
    Dim olApplication As Object, objEMail As Object
    Dim lngKw As Long
    Dim strFilePath As String

    If MsgBox("Du möchtest das Protokoll absenden und speichern?", vbYesNo Or vbQuestion) = vbYes Then

        lngKw = CalendarWeek(Date)

        Set objWorkbook = Workbooks.Open(Filename:= _
            "T:\Montage\Focus Factory_Tagesdurchschnitt OEE\OEE_Tagesdurchschnitt.xlsx", ReadOnly:=True)

        objWorkbook.Worksheets("KW" & Format$(lngKw, "00")).Copy

        Call objWorkbook.Close(SaveChanges:=False)

        strFilePath = Environ$("TMP") & "\" & "KW" & Format$(lngKw, "00")

        Call ActiveWorkbook.SaveAs(Filename:=strFilePath, FileFormat:=xlOpenXMLWorkbook)

        Call ActiveWorkbook.Close(SaveChanges:=False)

        Set rng = Worksheets("Frühschicht").Range("A1:H49")

        Set olApplication = CreateObject("Outlook.Application")

        Set objEMail = olApplication.CreateItem(0)

        With objEMail

            .To = "XXXXXXXXXXXXXX"

            .Subject = "Übergabe Frühschicht_MB"

            .HTMLBody = RangetoHTML(rng)

            Call .Attachments.Add(strFilePath)

            Call .Send

        End With

        Set olApplication = Nothing
        Set objEMail = Nothing
        Set objWorkbook = Nothing
        Set rng = Nothing

        Call Kill(PathName:=strFilePath)

    End If
End Sub

Private Function CalendarWeek(ByVal pvdtmDate As Date) As Long

    Dim dtmTepmDate As Date

    dtmTepmDate = 4 + pvdtmDate - Weekday(pvdtmDate, vbMonday)

    CalendarWeek = (dtmTepmDate - DateSerial(Year(dtmTepmDate), 1, -6)) \ 7

End Function

Gruß
Nepumuk

AW: Aktuelles Blatt versenden

09.02.2020 13:41:11

Uli

Hallo und danke für die Hilfe.
Das Macro bleibt hier hängen :
Call .Attachments.Add(strFilePath)

AW: Aktuelles Blatt versenden

09.02.2020 13:45:11

Nepumuk

Hallo Uli,
stimmt, die Funktion benötigt natürlich die Endung. Also:

 strFilePath = Environ$("TMP") & "\" & "KW" & Format$(lngKw, "00") & ".xlsx"

Gruß
Nepumuk

AW: Aktuelles Blatt versenden

09.02.2020 14:05:00

Uli

Danke jetzt klappt es.
Wo muss ich jetzt den Code einbauen damit es den gewollten Bereich vom Blatt ohne Fehler abspeichert als JPG ?
'ArbeitsmappeSpeichern()
ActiveSheet.Unprotect
Application.ScreenUpdating = False
ActiveSheet.Range("A1:H49").CopyPicture Appearance:=xlScreen, Format:=xlPicture
With ActiveSheet.ChartObjects.Add(0, 0, Range("A1:H49").Width, Range("A1:H49").Height).Chart
.ChartArea.Select
.Paste
.Export "T:\HSM\Schichtübergabe\Archiv\Frühschicht\" & Format(Now, "DD_MM_YYYY") & ActiveSheet.Name & ".jpg"
.Parent.Delete
End With
Application.ScreenUpdating = True
ActiveSheet.Protect
End If
ActiveWorkbook.Save

AW: Aktuelles Blatt versenden

09.02.2020 14:35:46

Uli

Hallo
Habe es hin bekommen !

AW: Aktuelles Blatt versenden

09.02.2020 14:36:50

Nepumuk

Hallo Uli,
welche Fehlermeldung erhälst du denn?
Gruß
Nepumuk

AW: Aktuelles Blatt versenden

09.02.2020 15:00:16

Uli

Hallo Nepumuk,
habe es selber hinbekommen. Danke für Deine Mühe. Kann ich jetzt alles Montag sofort einsetzen.
Schönes Wochenende

Beliebteste Forumthreads (12 Monate)

Forumthread: Aktuelles Blatt versenden

12 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu diesem und ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

12
Beiträge zum Forumthread

Beiträge zu diesem Forumthread