Live-Forum - Die aktuellen Beiträge
Datum
Titel
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
636to640
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
636to640
636to640
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Inhaltsverzeichnis

Mail zurück an Absender

Mail zurück an Absender
19.07.2005 09:16:39
Alex
Hi Excelisten,
ich weiss bin heute sehr lästig. Aber habe mal eine Frage, kann man eine gesendetes blatt beim versand ein makro mit senden das den Absender generiert und wo man das gesendet blatt einfach per button wieder zurück sendet ?
Also im klartext der empfänger soll die Möglichkeit haben das empangengde Blatt an den Absender per Button zurüch zu senden.
Hoffe jemand hat eine Idee ob dieses umsetzbar ist.
Gruß Alex

2
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Mail zurück an Absender
19.07.2005 09:34:33
marcl
Hallo Alex,
das in ien Modul:
Option Explicit
Public senden As String
Private Declare

Function FindWindow Lib "user32" Alias "FindWindowA" _
(ByVal szClass$, ByVal szTitle$) As Long
Public ausstieg As String

Sub emailalle()
' Modul aufrufen um zu prüfen, ob Outlook läuft
Application.Run ("Outlook_offen")
If ausstieg = "ja" Then Exit Sub
' Variablen deklarieren
Dim adresse
Dim nam
Dim blattname As String
Dim nachricht, anfzeile, tz, tabname, dateiname, stammwert, tabzahl, neuname, neuemappe, laaname, pfadname, pruefen
Dim nachricht1
Dim stat
Dim Frage
' Bestätigungen ausschalten
Application.DisplayAlerts = False
' variablen auslesen und festlegen
nam = ActiveSheet.Name
adresse = "Deine Adresse" ' hier Deine Meiladresse eintragen
'Sheets(stat).Select
pfadname = "C:\tmp\" & nam & ".xls"
' neue Arbeitsmappe anlegen mit den Statistiknamen und Berichtsmonat anlegen und speichern
Set neuemappe = Workbooks.Add
With neuemappe
.SaveAs Filename:=pfadname
End With
' zur orginalmappe wechseln und die Meldung in die neu erzeugte Mappe kopieren, vor Tabelle 1
ThisWorkbook.Activate
Sheets(nam).Select
Sheets(nam).Copy Before:=Workbooks(nam & ".xls").Sheets(1)
' Inhalte der Zellen kopieren und nur die Werte wieder einfügen, Leertabellen löschen
Cells.Select
Selection.Copy
Range("A1").Select
Application.CutCopyMode = False
Range("A1").Select
' Tabellenname ergänzen
neuname = nam
ActiveSheet.Name = neuname
' Leertabellen löschen
tabzahl = Sheets.Count
stammwert = 1
For tz = stammwert To tabzahl
If tabzahl = stammwert Then Exit For
If tz = tabzahl Then Exit For
tabname = "Tabelle" & tz
Sheets(Array(tabname)).Select
ActiveWindow.SelectedSheets.Delete
Next
' Modul aufrufen zum löschen der mit Makros belegten Buttons
'    ActiveSheet.Shapes.SelectAll
'   Selection.Delete
'  Cells.Select
' Selection.Copy
'Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
'Range("A1").Select
' Meldung als E-Mail versenden
ActiveWorkbook.SendMail Recipients:=adresse, Subject:=nam
With ActiveWorkbook
.SaveAs Filename:=pfadname
End With
' Druckfrage
Frage = MsgBox("1 Exemplar drucken?", vbOKCancel)
If Frage = 2 Then GoTo weiter
ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True
GoTo weiter
Exit Sub
weiter:
' Das neu erzeugte Meldungsfenster schliessen und anschließend aus dem Verzeichnis löschen
ActiveWindow.Close
On Error Resume Next
Kill (pfadname)
Application.StatusBar = "Die Meldung wurde versandt."
Application.DisplayAlerts = False
' Datei speichern
ActiveWorkbook.Save
Application.DisplayAlerts = True
Exit Sub
abbruch:
MsgBox ("Die Meldung wurde nicht versandt !!")
Application.DisplayAlerts = False
ActiveWorkbook.Save
Application.DisplayAlerts = True
End Sub

und da sin ein anderes:
Private Declare

Function FindWindow Lib "user32" Alias "FindWindowA" _
(ByVal szClass$, ByVal szTitle$) As Long
Public ausstieg As String

Sub Outlook_offen()
Dim outlookpruef, ergebnis
ausstieg = ""
On Error GoTo outlookfehler
' Prüfen ob Outlook gestartet ist
hFenster = FindWindow(vbNullString, "Microsoft Outlook")
If hFenster = 0 Then GoTo outlookfehler
If hFenster <> 0 Then Exit Sub
' Outlokk läuft nicht, dann Frage ob Outlook gestartet werden soll
outlookfehler:
outlookpruef = MsgBox("Microsoft Outlook wurde noch nicht gestartet !!!!!" & (Chr(10) & Chr(10)) & "Bitte starten Sie Outlook und versuchen es dann noch einmal.", vbOKOnly)
ausstieg = "ja"
Exit Sub
outlooklaeuft:
'    MsgBox ("Outlook läuft")
End Sub

Gruß
marcl
Anzeige
Danke für Deine hilfe. o.T.
19.07.2005 10:07:03
Alex
Gruß Alex

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige