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

[Niko]

Danke schon mal im Voraus ...licht aus.

[schauan]

Hallöchen,

mal die Fehler und Korrekturen der Reihe nach

- Sheets("Tabelle1", ?Tabelle2?, ?Tabelle3?).Copy        (Bei den Fragezeichen stehen bei mir "falsche" Gänsefüßchen)
--> Sheets(Array("Tabelle1", "Tabelle2", "Tabelle3")).Copy

- Set Nachricht = OutApp.CreateItem(0)
--> Set Nachricht = olApp.CreateItem(0)

-   With olMail
--> die Zeile muss weg

- Set wb = Workbooks(Workbooks.Count)
und später .Attachments.Add wb.FullName
sowie noch .Attachments.Add aws
--> Du kannst Dich für eins entscheiden. Ich habe Set wb = Workbooks(Workbooks.Count) und .Attachments.Add wb.FullName sowie das zugehörige Dim wb As Workbook auskommentiert und die andere Variante genommen. wegen dem wb sind noch weitere Änderungen weiter unten dabei

-       .Attachments.Add aws        (Du hast aws nicht dimensioniert und nirgendwo was zugewiesen)
-->        .Attachments.Add "C:\Temp\Temp.xls"

oder am Anfang des Codes
--> Dim AWS as String: AWS = "C:\Temp\Temp.xls
dann geht auch
-->        .Attachments.Add AWS

- 'strDatei = wb.FullName
--> kann weg einschl. oben das Dim strDatei … Hat eine weitere Änderung bei Kill zur Folge

- 'wb.Close False
--> ActiveWorkbook.Close False

- 'Kill strDatei
--> Kill AWS

- Set wb = Nothing
--> 'Set wb = Nothing
auskomentiert, da wb nicht mehr verwendet

- Sub End
--> End Sub

Darüber hinaus gibt es auch ein Problem mit
If blnQuit Then olApp.Quit
Das würde Dein Outlook schließen, ohne dass Du gesendet hast. Es kommt dann nur die Frage, ob DU die Nachricht speichern willst. Ich hab das daher mal auskommentiert.

Option Explicit

Sub senden()
Dim AWS As String: AWS = "C:\Temp\Temp.xls"
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 
Sheets(Array("Tabelle1", "Tabelle2", "Tabelle3")).Copy
'Die Datei temporär speichern 
'Workbooks(Workbooks.Count).SaveAs Filename:="C:\Temp\Temp.xls" 
Workbooks(Workbooks.Count).SaveAs Filename:=AWS
'Neue Nachricht in Outlook erzeugen 
'Set Nachricht = OutApp.CreateItem(0) 
Set Nachricht = olApp.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 
ActiveWorkbook.Close False
'Temporäre Datei löschen 
'Kill strDatei 
Kill AWS
'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 
End Sub

VBA/HTML-CodeConverter, AddIn für Office 2002-2016 - in VBA geschrieben von Lukas Mosimann. Projektbetreuung:RMH Software & Media
Code erstellt und getestet in Office 16 - mit VBAHTML 12.6.0

[Niko]

Hi schauan,

Vorab Vielen, vielen Dank für deine bisherige Mühe...und voralem ausdauer und geduld mit mir

Habe den Code eingespielt und zeigt mir fehler an der Zeile
"Workbooks(Workbooks.Count).SaveAs Filename:=AWS"
(dort stopt es)

Code:

Option Explicit

Sub senden()
Dim AWS As String: AWS = "C:\Temp\Temp.xls"
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
Sheets(Array("Tabelle1", "Tabelle2", "Tabelle3")).Copy
'Die Datei temporär speichern
'Workbooks(Workbooks.Count).SaveAs Filename:="C:\Temp\Temp.xls"
Workbooks(Workbooks.Count).SaveAs Filename:=AWS
'Neue Nachricht in Outlook erzeugen
'Set Nachricht = OutApp.CreateItem(0)
Set Nachricht = olApp.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
ActiveWorkbook.Close False
'Temporäre Datei löschen
'Kill strDatei
Kill AWS
'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
End Sub

By the Way...könnte ich statt ein Speicherplatz anzugeben etwas von diesen eingwfügtwn code einbauen,
so das ich kein speicherplatz anzugeben brauch.
Anstat dieser angabe ":="C:\Temp\Temp.xls" " so etwas in dieser richtung
"TempFilePath = Environ$("temp") & "\" "


Beispiel was ich im net gefunden habe.

Code:

Dim Sh As Worksheet
   TempFilePath = Environ$("temp") & "\"

   For Each Sh In ThisWorkbook.Worksheets
       FileName = ""
If Sh.Range("A2").Value Like "?*@?*.?*" Then
TempFileName = TempFilePath & "Sheet " & Sh.Name & " of " _
                        & ThisWorkbook.Name & " " _
                        & Format(Now, "dd-mmm-yy h-mm-ss") & ".xlsm"

           FileName = RDB_Create_Copy(Source:=Sh, _
                                     FixedFilePathName:=TempFileName, _
                                     OverwriteIfFileExist:=True, _
                                     OpenExcelAfterPublish:=False)

           'If publishing is OK create the mail
           If FileName <> "" Then

Thx again -)


Nikko

[schauan]

Hallo Niko,

gibt es denn bei Dir ein Verzeichnis C:\Temp?

Wenn Du es über Environment festlegen willst, dann oben

Dim AWS as String: AWS=Environ$("temp") & "\Temp.xls"

Mehr ist dann nicht nötig.

Du kannst dann auch mal den Code mit F8 schrittweise ausführen und Dir AWS in der Überwachung anzeigen lassen (Rechte Maustaste auf AWS, dann Überwachung hinzufügen wählen)
Dort solltest Du dann eine korrekte und vorhandene Pfadangabe mit dem Dateinamen Temp.xls sehen.
Warum nimmst Du eigentlich nicht xlsx als Format?

Du kannst, wie gesagt, so einzelne Sachen auch gesondert testen. Wo das mit dem Pfad bei Verwendung von Environ hingeht z.B.

Sub test()
MsgBox Environ$("temp") & "\Temp.xls"
End Sub

[mumpel]

Hallo!

1.:
Ersetze:
Dim AWS As String: AWS = "C:\Temp\Temp.xls"

durch:
Dim AWS As String

2.:
Ersetze:
Workbooks(Workbooks.Count).SaveAs Filename:=AWS

durch:
AWS = Environ("USERPROFILE") & "\Desktop\"
ActiveWorkbook.SaveAs Filename:AWS


Anmerkung:
Möglicherweise hast Du keinen Zugriff auf das Temp-Verzeichnis, kann bei Windows 10 passieren, dann fehlt natürlich der Dateiname.

Gruß, René

[mumpel]

Dim AWS as Sting: AWS=Environ$("temp") & "\Temp.xls"

Weshalb immer diese schrecklichen Einzeiler.

Ich würde übrigens immer auf dem Desktop speichern, dort ist der Zugriff garantiert.

[schauan]

Hallo René,

Dim AWS as Sting: AWS=Environ$("temp") & "\Temp.xls"
Weshalb immer diese schrecklichen Einzeiler.

So habe ich das gleich am Programmanfang im Blick und muss mich nicht durch den Code wursteln, wenn ich da mal was ändern will. Ob man das in einer Zeile schreibt oder in zweien sei mal dahingestellt.
In dem Fall ist es ja ein konstanter Wert. Geht allerdings nicht mit Const zu deklarieren wo man das in einer Zeile machen muss, weil man die Const nicht mit Variablen deklarieren kann

Workbooks(Workbooks.Count) und ActiveWorkbook bringen hier das Gleiche, deswegen hab ich da nix geändert...

[mumpel]

Ich persönlich mag die Einzeiler nicht. Ich bevorzuge Kommentare und die Suche.

[Niko]

Hallo an alle,

Vorab Danke...aber das ist zuviel für ein Einäugigen wie mich in sachen VBA (milde ausgedrückt )


Habe die änderungen durch genommen aber de rfehler der selbe es sTopt an der Zeile       ".Attachments.Add AWS "

Ein durchgelaufenen/getesteten code mit Environ...wäre gut

Wie auch immer, werde weiter versuchen vieleicht klappt es ja...oder ich geb den Geist ab

Danke,
Nikko

[Niko]

Bin echt schwer von Begriff…mir brennt die Birne schon :72:
Versuche den ganzen Tag schon den Code in einer Reihe zu bringen...ohne Erfolg  :70:
 
 
Jungs ein bisschen Hilfe könnte ich vertragen :60: :100:
 
bin kurz vom hinschmeißen

Danke