Live-Forum - Die aktuellen Beiträge
Anzeige
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

Aktuelles Blatt versenden

Forumthread: Aktuelles Blatt versenden

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
Anzeige

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

Betreff
Datum
Anwender
Anzeige
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
Anzeige
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
Anzeige
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" _
Anzeige
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
Anzeige
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
Anzeige
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
Anzeige
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
Anzeige
;

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Entdecke mehr
Finde genau, was du suchst

Die erweiterte Suchfunktion hilft dir, gezielt die besten Antworten zu finden

Suche nach den besten Antworten
Unsere beliebtesten Threads

Entdecke unsere meistgeklickten Beiträge in der Google Suche

Top 100 Threads jetzt ansehen
Anzeige