Ausgewählte Blätter mail senden (Outlook und WebMail)

[Niko]

Hallo an alle,
 
Brauche ein bisschen Hilfe
Habe mir diesen Code aus dem Internet zusammengebaut bzw. Copy hin und her bis Paste
Möchte folgendes ändern, statt die ganze Arbeitsmappe, soll es nur ausgewählte Arbeitsblätter (mit Macros und Formeln) per Mail senden.  
Gleichzeitig soll es mit Outlook und Web Mail versendet werden können.
 
Falls jemand eine Idee hat, ist herzlich Willkommen

Code:

Sub Excel_Workbook_via_Outlook_Senden()
Dim Nachricht As Object, OutApp As Object
Dim GruppenName, KasseMonat As String
Set OutApp = CreateObject("Outlook.Application")
Dim AWS As String
AWS = ThisWorkbook.FullName
GruppenName = ThisWorkbook.Sheets("Menu").Range("B7")

KasseMonat = Month(CDate(ThisWorkbook.Sheets("Menu").Range("A3"))) & "/" & Year(CDate(ThisWorkbook.Sheets("Menu").Range("A3")))
Set Nachricht = OutApp.CreateItem(0)
With Nachricht
        .To = "MyBill@ausgaben.de"
        .Subject = "Abrechnung - Gruppe: " & GruppenName & " - Monat: " & KasseMonat & " - " & Date & Time
        .Attachments.Add AWS
        .Body = "Bitte Drücken Sie auf Senden und die abrechnung wird im flug gesendet." & vbCrLf & "Vielen Dank."
        .Display
       
End With

Set OutApp = Nothing
Set Nachricht = Nothing
MsgBox "NICHT VERGESSEN !" & vbNewLine & "Aus… Drucken.", vbInformation, "Kollegius"
End Sub

Thx in Advance,
Nikko

[schauan]

Hallöchen,

du hast im Moment zur Vorbereitung des Versandes das:

AWS = ThisWorkbook.FullName

- Speicher eine Kopie des gewünschten Blattes mit Copy …
  die Kopie ist anschließend das aktive Workbook
- anschließend dann AWS = ActiveWorkbook.FullName

[Niko]

Hallo ...ein kleiner script würde helfen! ..meine VBA Kenntnisse reduzieren sich auf das copy/Paste system
 

Danke,
Nikko

[schauan]

Hallöchen,

statt
…
AWS = ThisWorkbook.FullName
…

dann neu

…
ActiveSheet.Copy
AWS = ActiveWorkbook.FullName
…

[Niko]

hi schauan,


Sry aber manchmal bin ich schwer von begriff
Soweit ich den Befehl verstehen kann, soll es, anstatt die aktive Arbeitsmappe, das aktive Arbeitsblattblatt kopieren.
Möchte aber bestimmte Blätter (nicht nur ein aktives Blatt) vom aktiven Arbeitsblatt per Mail versende. Beispiel wenn die Arbeitsmappe 20 Blätter hat (von 1 bis 20 benannt), möchte ich nur die Blätter 3,5,7,14 & 17 in die Mail einfügen sowie als einheitliche Arbeitsmappe versenden .

Wie kann ich dies mit der von dir gesendeten Befehles Zeile bewerkstelligen?

Sry nochmal wenn ich Kopfschmerzen mit meiner Unwissenheit bereite, doch irgendwie muss ich auch zum licht des Wissens rankommen…auch wenn’s vom weiten sei :72:



Danke,
Nikko

[schauan]

Hallo Nikko,

Ich weiß ja nicht, wann Du welches Blatt per E-Mail senden willst, und ob Du eins oder mehrere zugleich ausgewählt hast stand am Anfang auch nicht in der Frage
Der Code würde passen, wenn Du ein Blatt gewählt hast.

Du könntest z.B. in eine Schleife nehmen und alle manuell markierten Blätter verarbeiten:

Code:

Sub test()
'Variablendeklarationen
Dim AWS As String
Dim shBlatt As Worksheet, wbBook As Workbook, iCnt As Integer
'Schleife ueber alle manuell gewaehlten Blaetter
For Each shBlatt In ActiveWindow.SelectedSheets
  'Beim ersten Blatt ...
  If iCnt = 0 Then
  'neue Mappe anlegen und Blatt reinkopieren
  shBlatt.Copy
  Set wbBook = ActiveWorkbook
  'oder ab dem naechsten Blatt
  Else
    'Blatt in neue Mappe kopieren
  shBlatt.Copy Before:=wbBook.Sheets(1)
  'Ende Beim ersten Blatt ...
  End If
  'Zaehler hochsetzen
  iCnt = iCnt + 1
'Ende Schleife ueber alle manuell gewaehlten Blaetter
Next
'neue Datei nach C:\Tem speichern
wbBook.SaveAs "C:\Temp\MailBook.xlsx"
'AWS uebernehmen
AWS = ActiveWorkbook.FullName
End Sub

Der Code würde jetzt diese beiden Zeilen ersetzen:

Dim AWS As String
AWS = ThisWorkbook.FullName


Sub test () und End Sub musst Du natürlich entfernen.

[Niko]

Danke für deine Hilfe

Es ist nicht das was ich eigentlich suche, doch möchte auch deine Geduld mit mir, nicht mehr strapazieren.
 
Die Nummerierung wurde als Beispiel genannt und ist als Benennung wahrzunehmen.
Die Blätter werden nicht so heißen (1,2,3,4,5,etc.), haben übliche Namensbenennung wie Nikko, schauan, horst, erwin, etc. .
Gleichzeitig muss ich in diesen Code ein Speicherplatz benennen, denn ich aber von vorneherein nicht weiß, da die Datei in verschiedenen Rechnern gleichzeitig sein wird.
Am Ende fehlt mir auch eine Lösung um diesen Code nicht nur durch Outlook zu senden sondern auch durch Web Mail, wenn es ein solches in ein Rechner eines Kollegen gibt.
 
Wie auch immer, danke dir echt für deine Mühe, ich weiß auch wie anstrengend es ist, den anderen Fischen beizubringen.

Nikko

[schauan]

Hallo Nikko,

der Code enthält ja schon einiges, was ausbaufähig ist.

Die Blätter werden nicht so heißen (1,2,3,4,5,etc.),

Deswegen hab ich eine Variante wo Du erst manuell einige Blätter auswählst und dann läuft der Code über alle ausgewählten Blätter.
Man kann auch mehrere Namen im Code definieren oder auf einem Blatt eine Liste mit den Namen erstellen und die könnte man mit Formeln sogar noch variabel halten.
Viele Wege führen nach Rom, und wenn sie gut beschrieben sind, findet man sie auch

Gleichzeitig muss ich in diesen Code ein Speicherplatz benennen

Auch dafür ist was im Code:
'neue Datei nach C:\Temp speichern
wbBook.SaveAs "C:\Temp\MailBook.xlsx"

Wenn es an andere Stelle soll, einfach nur ändern was da in den Gänsefüßchen steht … Hier gilt auch wieder das zuvor geschriebene, es gibt mehrere Varianten wie man zu einem Verzeichnis und einem Dateinamen kommen kann und welche die richtige ist, sollte aus einer entsprechenden Beschreibung hervorgehen.

Nur mit Web Mail kann ich nicht dienen

Den Code kannst Du übrigens in einer neuen Datei ausprobieren. Einfach eine Datei mit mehreren Blättern nehmen, einige selektieren und den Code ausführen ...
Würde ich an Deiner Stelle auch so machen um erst mal den Teil des Speicherns 100% zum Laufen zu bringen. Gesendet wird dann in Teil 2 der Entwicklung die gespeicherte Datei.

[Niko]

so etwas meinte ich...habe das ganze im copy/paste system zusammengewürfeld...irgenwo hagt es...muss herumbastelln...vieleicht klappt es.

Versuche es zum laufen zu bringen doch..komm irgend wie auch nicht weiter...zu viele befehle die sich gegenseit aufheben...wer weiss..ich net

Fall Hilfe kommt ist sie sehr wilkommen

Code:

Sub senden()

Dim olApp As Object
Dim olMail As Object
Dim blnQuit As Boolean
Dim wb As Workbook
Dim strDatei As String
Dim Nachricht As Object, OutApp As Object
Dim GruppenName, KasseMonat As String
GruppenName = ThisWorkbook.Sheets("Menu").Range("B7")
KasseMonat = Month(CDate(ThisWorkbook.Sheets("Menu").Range("A3"))) & "/" & Year(CDate(ThisWorkbook.Sheets("Menu").Range("A3")))
'Laufzeitfehler übergehen
On Error Resume Next
'Aktive Outlookinstanz übernehmen
Set olApp = GetObject(, "Outlook.Application")
'Falls Outlook nicht geöffnet
If olApp Is Nothing Then
 'Merkvariable setzen
 blnQuit = True
 'Neue Outlookinstanz öffnen
 Set olApp = CreateObject("Outlook.Application")
End If
'Bei Laufzeitfehlern wieder abbrechen
On Error GoTo 0

'Zu versendentes Tabellenblatt in eigene Datei auslagern
Sheets("Tabelle1",  “Tabelle2“,  “Tabelle3“).Copy
'Die Datei temporär speichern
Workbooks(Workbooks.Count).SaveAs Filename:="C:\Temp\Temp.xls"

'Neue Nachricht in Outlook erzeugen
Set Nachricht = OutApp.CreateItem(0)
With Nachricht
With olMail
 'Zu versendende Datei in Variable übergeben
 Set wb = Workbooks(Workbooks.Count)
       .To = "MyBill@ausgaben.de"
       .Subject = "Abrechnung - Gruppe: " & GruppenName & " - Monat: " & KasseMonat & " - " & Date & Time
       .Attachments.Add AWS
       .Body = "Bitte Drücken Sie auf Senden und die abrechnung wird im flug gesendet." & vbCrLf & "Vielen Dank."
 .Attachments.Add wb.FullName
       .Display
     
End With
'Pfad und Name der temporären Datei in Variable übergeben
strDatei = wb.FullName
'Temporäre Datei schließen, ohne zu speichern
wb.Close False
'Temporäre Datei löschen
Kill strDatei
'Wenn neue Outlookinstanz geöffnet, diese wieder schließen
If blnQuit Then olApp.Quit

'Speicherbereiche freigeben
Set wb = Nothing
Set olMail = Nothing
Set olApp = Nothing
Set OutApp = Nothing
Set Nachricht = Nothing
MsgBox "NICHT VERGESSEN !" & vbNewLine & "Aus… Drucken.", vbInformation, "Kollegius"

Sub End

[schauan]

Hi Niko,

ich schau's mir morgen an, jetzt geh ich erst mal offline