Zellen auslsen und per Outlock verschicken

[knallebumm]

@ all
Danke.
Es klappt fast, nur mit den Anpassungen der Zellen bin ich gerade im Zickenkrieg mir Exel.
Ich probier es erst mal selber, aber bevor es aus dem Fenster fliegt, würd eich euch wieder um Hilfe bitten.

Gruß
Thomas

[knallebumm]

Hallo,
dies ist jezze ganz klasse wie es läuft.
Nur mit dem Manen der neuen Tabelle bin ich nicht ganz glücklich.

Da hätte ich gern den Namen aus B3 der Ursprungstabelle oder A 2 aus tabelle 2 nur mit dem Datum.

Wenn ich aber statt
ActiveSheet.Name Range ("A3")

mag er nicht mehr.
Aber eine andere Stelle fällt mir nicht ein wo ich den Namen ändern könnte.


Gruß
Thomas

[schauan]

Hallo Thomas,

wenn, dann mit "=" dazwischen
ActiveSheet.Name = Range("A3")

[Steffl]

Hallo Thomas,

ergänzend zu der Antwort von André würde ich zur Sicherheit vor dem Range noch das Worksheet einfügen.

Code:

ActiveSheet.Name = Worksheets("Tabelle2").Range("A3")

Bitte den Tabellennamen anpassen!

[knallebumm]

Hallo,
mit den Lösungen von Andrè und Stefan hat es leider nicht geklappt.
Aber ich habe dadurch einen Ansatz bekommen und es so gelöst.

ActiveWorkbook.SaveAs Filename:=Range("A2") & " " & Format(Date, "dd.mm.yyyy") & ".xls"

Die Datei wird zwar warum auch immer nicht gespeichert ( vorgestern wurden sie noch gespeichert), ist auch nicht wichtig da ich die Ursprungstabelle ja habe und die Mail mit dem Namen gesendet wird.
Und ich habe keine 100 Tabellen die ich eh nicht benötige.

Also vielen Dank an alle und bestimmt bis bald mal wieder.

Meine Schiedsrichterkollegen werden es euch danken.

Thomas

[schauan]

Hallo Thomas,

in meinem code wird die temporäre Datei am Ende weggelöscht (Zeile mit kill).

[knallebumm]

Bitte verzeih mir,
aber ich hatte den Code von Attila genommen.
Und wie gesagt ich habe ausser dem Filname nichts geändert.
Vorgestern noch gespeichert heute nicht mehr.

Aber solange es läuft und das macht was ich will ist es mir egal.
Mir fehlt die Tiefe des Vestehens um Fehler zu finden.

Wer suchen möchte, des Interesse wegens

Code:

Option Explicit

Sub Excel_Serial_Mail()
    Dim MyMessage As Object, MyOutApp As Object
    Dim SavePath As String
    Dim strgBody As String
    Dim AWS As String
    Dim i As Long, lngZ As Long
   strgBody = Sheets("Tabelle2").Range("A1").Value
   With Sheets("Tabelle1")
      lngZ = .Cells(.Rows.Count, 1).End(xlUp).Row
      If lngZ > 1 Then
         .Range(.Cells(2, 1), .Cells(lngZ, 17)).ClearContents
      End If
   End With
   With Sheets("Liste Namen")
      lngZ = .Cells(.Rows.Count, 18).End(xlUp).Row
   End With

   Sheets("Tabelle1").Select
   For i = 3 To lngZ
         With Sheets("Liste Namen")
            Range(Cells(2, 1), Cells(2, 17)).Value = .Range(.Cells(i, 2), .Cells(i, 18)).Value
         End With
             SavePath = "D:\Persönliche Daten\Desktop\Schiedsrichter Obmann NBSV\Umpire Liste\Listen für Schiedsrichter\" '"E:\Eigene Dateien"
       'Kopiert aktuelles Sheet in eine neue Mappe
       'welche nur diese Tabelle enthält
       ActiveSheet.Copy
       'Speichert die Datei unter dem Tabellennamen und einem Zeitstempel
      ActiveWorkbook.SaveAs Filename:=Range("A2") & " " & Format(Date, "dd.mm.yyyy") & ".xls"
       'Mappenname wird an Variable übergeben
       'und anschliessend gleich geschlossen
       With ActiveWorkbook
           AWS = .FullName
           .Close
       End With
      Set MyOutApp = CreateObject("Outlook.Application")
      Set MyMessage = MyOutApp.CreateItem(0)
      With MyMessage
          'Der Empfänger stehet in Spalte Q in Zeile 2
          .To = Cells(2, 17).Value 'E-Mail Adresse
          'Der Betreff in Spalte B
          .Subject = "Lizenzstatus Schiedsrichter Baseball" '"Betreffzeile"
          .Attachments.Add AWS
          'Der zu sendende Text in Spalte C
          'Maximal 1024 Zeichen
          'Der Text wird ohne Formatierung übernommen
          .Body = strgBody
          'Hier wird die Mail angezeigt
          '.Display
          'Hier wird die Mail gleich in den Postausgang gelegt
          .Send
      End With
      
      Application.DisplayAlerts = False
      'Objectvariablen leeren
      MyOutApp.Quit
      Set MyOutApp = Nothing
      Set MyMessage = Nothing
      'Sendepause einschalten
      'Outlook kann die Aufträge nicht schnell genug verarbeiten
      Application.Wait (Now + TimeValue("0:00:05"))
      Kill AWS
      Application.DisplayAlerts = True
   Next i
    
End Sub

Gruß
Thomas

Aus Zitat einen Code gemacht, dadurch strukturiert dargestellt (3. Button von rechts im Beitragsformular: #)
[Bild: smilie.php?smile_ID=1810]

[schauan]

Hallo Thomas,

Atilla hat auch ein(en) Kill(er) drin :21:

Kill AWS