Anzeige
Archiv - Navigation
904to908
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
904to908
904to908
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Inhaltsverzeichnis

Mail Anhang makro o. VBA-Codes

Mail Anhang makro o. VBA-Codes
10.09.2007 08:10:07
marcus
Guten Morgen,
ich benutze momentan folgendes Emailmakro.
Ich möchte aber gerne das bevor der Anhang verschickt wird, alle VBA-Codes deaktiviert werden. Ist das möglich?
Hier der Code:

Sub Mail_workbook_Outlook_1()
'Working in 2000-2007
'This example send the last saved version of the Activeworkbook
Dim OutApp As Object
Dim OutMail As Object
Set OutApp = CreateObject("Outlook.Application")
OutApp.Session.Logon
Set OutMail = OutApp.CreateItem(0)
On Error Resume Next
With OutMail
.To = "test"
.CC = ""
.BCC = ""
.Subject = "test "
.Body = "Hallo Zusammen," & vbCrLf & vbCrLf _
& "bitte folgende Artikel schnellstmöglich mitbestellen." & vbNewLine _
& vbCrLf & vbCrLf _
& "test"
.Attachments.Add ActiveWorkbook.FullName
'You can add other files also like this
'.Attachments.Add ("C:\test.txt")
.Display   'or use .Send
End With
On Error GoTo 0
Set OutMail = Nothing
Set OutApp = Nothing
End Sub


4
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Mail Anhang makro o. VBA-Codes
10.09.2007 08:24:37
Oberschlumpf
Hi marcus
Makros de- oder aktivieren kann nur der User, der die Datei öffnet.
Was du tun könntest, ist...
...bevor du die Datei verschickst, kopiere alle Tabellenblätter OHNE VBA-Code in eine neue, temporäre Datei
...versende dann nur die temporäre Datei
...lösche nach dem Versenden die temporäre Datei
So ist ein VBA-Code nicht mehr vorhanden, und kann auch aus Versehen nicht aktiviert werden.
Zumindest ich kenne keine andere Möglichkeit.
Hilft das denn, oder MUSS der Code vorhanden sein, auch wenn er nicht aktiviert werden soll?
Ciao
Thorsten

Anzeige
AW: Mail Anhang makro o. VBA-Codes
10.09.2007 08:32:00
marcus
Hallo Thorsten,
das klingt schon mal nicht schlecht. Es genügt eine "nackte" Datei o. Codes zum versenden. :-)
Wie kann ich denn ein Tabellenblatt ohne VBA Codes kopieren? Und wie löscht er mir dann die temp Datei?
Kann ich das in meinen bestehenden Code einbauen?
Grüße
Marcus

AW: Mail Anhang makro o. VBA-Codes
10.09.2007 09:22:00
Oberschlumpf
Hi Marcus
Vllt schaffst du das
Erstellen einer neuen Datei
Kopieren der Blätter ohne Code und Einfügen in neue Datei
Speichern der neuen Datei
Versenden der neuen Datei
Löschen der neuen Datei
auch selbst.
Und zwar mit dem Makro-Recorder
1. Starte den Recorder
2. Erstell eine neue Excel-Datei
3. Wechsel in deine Datei zurück (natürlich, ohne die neue zu schließen)
4. Wechsel in das nächste Sheet mit den zu kopierenden Daten
5. Markiere ALLE zu kopierenden Zellen
6. Klick auf Bearbeiten/Kopieren
7. Wechsel zur neuen Datei ins nächste freie Sheet in Zelle A1 und drück die Enter-Taste
8. Wiederhole die Schritte 3-7
9. Wenn kopieren/einfügen fertig, speicher die neue Datei unter einem Namen
10. Starte dein Makro zum Versenden der Datei (natürlich musst du den Code mit dem neuen DAteinamen/Pfad anpassen)
11. Lösche die neue Datei
12. Beende den Makrorecorder
Hilft das?
Ciao
Thorsten

Anzeige
AW: Mail Anhang makro o. VBA-Codes
10.09.2007 14:01:00
marcus
Hallo Thorsten,
hab das jetzt mal so probiert und entsprechend das Makro dann erweitert bzw. getestet.
Läuft jetzt super aber war dann doch noch etwas komplizierter.
Ich habe langsam Blut geleckt.. :-)
Also nochmals vielen Dank für den Tipp.
Gruß
Marcus

Sub REK_Mail_Neu()
Application.Run "Sheets_kopieren"
Application.Run "Mail_versenden"
Application.Run "Wartezeit"
Application.Run "Datei_schliessen"
Application.Run "Temp_Datei_loeschen"
End Sub
Sub Mail_versenden()
'Working in 2000-2007
'This example send the last saved version of the Activeworkbook
Dim OutApp As Object
Dim OutMail As Object
Set OutApp = CreateObject("Outlook.Application")
OutApp.Session.Logon
Set OutMail = OutApp.CreateItem(0)
On Error Resume Next
With OutMail
.To = "muhkuh@blubb.de"
.CC = ""
.BCC = ""
.Subject = "Überweiser " & InputBox("Welche Firmen sollen bestellt werden?")
.Body = "Hallo Zusammen," & vbCrLf & vbCrLf _
& "bitte folgende Artikel schnellstmöglich mitbestellen." & vbNewLine _
& vbCrLf & vbCrLf _
& "Dankeschön und viele Grüße" & vbCrLf & vbCrLf
.Attachments.Add ActiveWorkbook.FullName
'You can add other files also like this
'.Attachments.Add ("C:\test.txt")
.Display   'or use .Display
End With
On Error GoTo 0
Set OutMail = Nothing
Set OutApp = Nothing
End Sub
Sub Temp_Datei_loeschen()
Kill ("C:\Temp\UEberweisertemp.xls")
End Sub
Sub Wartezeit()
Application.Wait Now + TimeValue("00:00:4")
End Sub
Sub Datei_schliessen()
Application.ActiveWorkbook.Close SaveChanges:=False
Windows("ueberweiser.xls").Activate
Sheets("1A Pharma").Select
End Sub
Sub Sheets_kopieren()
' REK_Mail Makro
' Makro am 10.09.2007 von ErmannM aufgezeichnet
Application.DisplayAlerts = False
Workbooks.Add
Sheets("Tabelle1").Select
ActiveWindow.SelectedSheets.Delete
Sheets("Tabelle2").Select
ActiveWindow.SelectedSheets.Delete
Sheets("Tabelle3").Select
Windows("ueberweiser.xls").Activate
Sheets("1A Pharma").Select
Sheets("1A Pharma").Copy Before:=Workbooks("Mappe1").Sheets(1)
Sheets("Tabelle3").Select
ActiveWindow.SelectedSheets.Delete
Windows("ueberweiser.xls").Activate
Sheets("CT").Select
Sheets("CT").Copy After:=Workbooks("Mappe1").Sheets(1)
Windows("ueberweiser.xls").Activate
Sheets("Betapharm").Select
Sheets("Betapharm").Copy After:=Workbooks("Mappe1").Sheets(2)
Windows("ueberweiser.xls").Activate
Sheets("Hexal").Select
Sheets("Hexal").Copy After:=Workbooks("Mappe1").Sheets(3)
Windows("ueberweiser.xls").Activate
Sheets("Madaus").Select
Sheets("Madaus").Copy After:=Workbooks("Mappe1").Sheets(4)
Windows("ueberweiser.xls").Activate
Sheets("Merck Dura").Select
Sheets("Merck Dura").Copy After:=Workbooks("Mappe1").Sheets(5)
Windows("ueberweiser.xls").Activate
Sheets("Pfizer").Select
Sheets("Pfizer").Copy After:=Workbooks("Mappe1").Sheets(6)
Windows("ueberweiser.xls").Activate
Sheets("Ratiopharm").Select
Sheets("Ratiopharm").Copy After:=Workbooks("Mappe1").Sheets(7)
Windows("ueberweiser.xls").Activate
Sheets("Sandoz").Select
Sheets("Sandoz").Copy After:=Workbooks("Mappe1").Sheets(8)
Windows("ueberweiser.xls").Activate
Sheets("Sidroga").Select
Sheets("Sidroga").Copy After:=Workbooks("Mappe1").Sheets(9)
Windows("ueberweiser.xls").Activate
Sheets("Sonstige").Select
Sheets("Sonstige").Copy After:=Workbooks("Mappe1").Sheets(10)
Application.DisplayAlerts = True
Application.ActiveWorkbook.SaveAs ("C:\Temp\Ueberweisertemp.xls")
End Sub


Anzeige

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige