simon-ni
28.03.2011
view6196
view5
0
Goto Top

Geöfnette Ecxel 2003 Datei per Makro versenden

gelöstFrageMicrosoftMicrosoft Office
Hallo Forum,

ich muss einen absenden button in Excel 2003 so programieren das sich die gesamte gerade geöfnete datei(mit allen sheets), an mehrere empfänger sendet (ca.8).

Dieses makro funktioniert in word sehr gut, ich bekomme es aber in excel nicht zum laufen, entweder sendet er nur das aktive sheet, oder er macht garnichts.


Private Sub CommandButton2_Click()
'das gesamte dokument per mail verschicken
'Options.SendMailAttach = True
With ActiveDocument _
.MailEnvelope.Item
.To = "ich@ich.com;ich2@ich2.com"
.Subject = "Test"
.Send
End With
End Sub


Ich habe auch einige andere möglichkeiten gefunden, bei welchen sich aber ein outlook fenster öffnet, oder sich dieses lästige fenster, bei welchem man das senden bestätigen muss, für jede eingetragene Adresse öffnet. Dies soll aber nicht der fall sein.

Ich hoffe ihr könnt mir helfen, und ja ich weiß das es dazu schon beiträge gibt, ich aber nichts passendes gefunden hab, da ich eigentlich nicht viel ahnung von vba/vbs? hab.

Vielen Dank

Nico
ShareTeilen
Auf Facebook teilen Auf Twitter teilen Auf Reddit teilen Auf Linkedin teilen

Content-ID: 163437

Url: https://administrator.de/forum/geoefnette-ecxel-2003-datei-per-makro-versenden-163437.html

Ausgedruckt am: 23.12.2024 um 14:12 Uhr

5 Kommentare
Neuester Kommentar
Goto Top
76109
76109 28.03.2011 um 09:50:39 Uhr
Goto Top
Hallo simon-ni!

Mit diesem Code wird das Standard-Mail-Programm verwendet. In meinem Fall ist das Thunderbird, bei dem 1 mal mit OK für alle bestätigt werden muss. Der Versuch die Arbeitsmappe auf andere Weise zu versenden ist leider daran gescheitert, weil die Arbeitsmappe geöffnet ist.

Private Sub CommandButton2_Click()
    Dim An(1 To 8) As String
    
    An(1) = "a@xy.de"  
    An(2) = "b@xy.de"  
    '...  
    An(8) = "h@xy.de"  

    ActiveWorkbook.SendMail Recipients:=An, Subject:="Test"  
End Sub

Gruß Dieter
83928
83928 28.03.2011 um 10:29:04 Uhr
Goto Top
Hi,
hier noch ein paar Möglichkeiten.

Eine Möglichkeit die geöffnete Excel-Datei zu versenden funktioniert so:
 
    sAddr = "mail1@domain.de;mail1@domain.de"  
    sBetreff = "betraff"  
    Application.Dialogs(xlDialogSendMail).Show sAddr, sBetreff


Hier musst Du noch 1 Klick zum versandt machen (egal wie viele Empfänger)


Ein wenig aufwändiger, aber weitaus flexibler ist diese Methode (ich geh mal davon aus, dass Du Outlook hast).
Unter ->Extras->Verweise musst Du dazu noch den Verweis auf die "Microsoft Outlook XX Object Library" aktivieren.

Hiermit kannst Du noch einen Text in die Mail einfügen (.Body) und auch mehrere Dateien anhängen.
Die Zeile "SendKeys %s" sorgt dafür, das Du im Outlook nicht mehr auf "Senden" klicken musst

 
    Dim olApp As Outlook.Application
    Dim olNamespace As Namespace
    Dim objMailItem As MailItem
    Dim objFolder As mapiFolder
    
    Set olApp = CreateObject("Outlook.Application")  
    Set olNamespace = olApp.GetNamespace("MAPI")  
    Set objFolder = olNamespace.GetDefaultFolder(olFolderInbox)
    Set objMailItem = objFolder.Items.Add(olMailItem)
    
    With objMailItem
        .To = "mail1@domain.de;mail1@domain.de"  
        .Subject = ""  
        .Body = ""  
        .Attachments.Add "c:\tmp\test.xls"  
        .Display
    End With
    olApp.ActiveWindow
    SendKeys "%s"
simon-ni
simon-ni 28.03.2011 um 10:44:54 Uhr
Goto Top
Funktioniert einwandfrei, danke
simon-ni
simon-ni 28.03.2011 um 10:46:42 Uhr
Goto Top
Bei der ersten möglichkeit öffnet sich ein outlook fenster, was nicht passieren soll.

Für die zweite möglichkeit müsste ich die policy ändern, was ich leider nicht einfach so machen kann.

Trotzdem danke für die Mühe.
101993
101993 17.08.2011 um 12:23:39 Uhr
Goto Top
Hallo,

ich steh vor einer etwas spezielleren Herausforderung:

ich habe eine Ausgangsdatei, welche ich mittels nachfolgendem makro, nach einem Kriterium in 18 einzelne Dateien aufsplitte

Option Explicit
Sub Pivotrefresh()

    Worksheets("Pivot").Activate  
    ActiveSheet.PivotTables("PivotTable8").PivotCache.Refresh  
    
End Sub

Sub Start()

Dim I As Byte, K As Integer, X As Integer, Y As Integer
Dim Kriterium As String, Pfad As String
Dim AW As String

'Dies bitte anpassen => Pfad, wo gespeichert werden soll  
Pfad = "C:\"  

'Bildschirmaktualisierung abschalten  
Application.ScreenUpdating = False

'Datenbasis neu aufstellen  
Pivotrefresh

'Zum richtigen Tabellenblatt springen  
Worksheets("Quelle").Activate  

'Ende der Quelle finden  
Worksheets("Quelle").Cells(Rows.Count, 2).End(xlUp).Activate  
K = Replace(ActiveCell.Address(False, False), "B", "")  

'Beginn in Zeile => Pivottabelle  
I = 5

'Loslaufen  
Do

    'Ersten Eintrag der zu filternden Kriterien  
    Kriterium = Worksheets("Pivot").Cells(I, 1)  
      
    'Für jedes Kriterium ein Tabellenblatt  
    Worksheets.Add
    ActiveSheet.Name = Kriterium
    
    'Zunächst die Überschriften setzen  
    Worksheets(Kriterium).Cells(1, 1) = Worksheets("Quelle").Cells(1, 1)  
    Worksheets(Kriterium).Cells(1, 2) = Worksheets("Quelle").Cells(1, 2)  
    Worksheets(Kriterium).Cells(1, 3) = Worksheets("Quelle").Cells(1, 3)  
    Worksheets(Kriterium).Cells(1, 4) = Worksheets("Quelle").Cells(1, 4)  
    Worksheets(Kriterium).Cells(1, 5) = Worksheets("Quelle").Cells(1, 5)  
    Worksheets(Kriterium).Cells(1, 6) = Worksheets("Quelle").Cells(1, 6)  
    Worksheets(Kriterium).Cells(1, 7) = Worksheets("Quelle").Cells(1, 7)  
    Worksheets(Kriterium).Cells(1, 8) = Worksheets("Quelle").Cells(1, 8)  
    Worksheets(Kriterium).Cells(1, 9) = Worksheets("Quelle").Cells(1, 9)  
    Worksheets(Kriterium).Cells(1, 10) = Worksheets("Quelle").Cells(1, 10)  
    Worksheets(Kriterium).Cells(1, 11) = Worksheets("Quelle").Cells(1, 11)  
    Worksheets(Kriterium).Cells(1, 12) = Worksheets("Quelle").Cells(1, 12)  
    Worksheets(Kriterium).Cells(1, 13) = Worksheets("Quelle").Cells(1, 13)  
    Worksheets(Kriterium).Cells(1, 14) = Worksheets("Quelle").Cells(1, 14)  
    Worksheets(Kriterium).Cells(1, 15) = Worksheets("Quelle").Cells(1, 15)  
    Worksheets(Kriterium).Cells(1, 16) = Worksheets("Quelle").Cells(1, 16)  
    Worksheets(Kriterium).Cells(1, 17) = Worksheets("Quelle").Cells(1, 17)  
        
    'Zeile in jedem Tabellenblatt wieder auf zwei setzen  
    Y = 2
    
    'Die Quelle vom Anfang bis Ende durchlaufen  
    For X = 2 To K
      
        'Sofern Kriterium entspricht, kopieren  
        If Worksheets("Quelle").Cells(X, 2) = Kriterium Then  
            
            Worksheets(Kriterium).Cells(Y, 1) = Worksheets("Quelle").Cells(X, 1)  
            Worksheets(Kriterium).Cells(Y, 2) = Worksheets("Quelle").Cells(X, 2)  
            Worksheets(Kriterium).Cells(Y, 3) = Worksheets("Quelle").Cells(X, 3)  
            Worksheets(Kriterium).Cells(Y, 4) = Worksheets("Quelle").Cells(X, 4)  
            Worksheets(Kriterium).Cells(Y, 5) = Worksheets("Quelle").Cells(X, 5)  
            Worksheets(Kriterium).Cells(Y, 6) = Worksheets("Quelle").Cells(X, 6)  
            Worksheets(Kriterium).Cells(Y, 7) = Worksheets("Quelle").Cells(X, 7)  
            Worksheets(Kriterium).Cells(Y, 8) = Worksheets("Quelle").Cells(X, 8)  
            Worksheets(Kriterium).Cells(Y, 9) = Worksheets("Quelle").Cells(X, 9)  
            Worksheets(Kriterium).Cells(Y, 10) = Worksheets("Quelle").Cells(X, 10)  
            Worksheets(Kriterium).Cells(Y, 11) = Worksheets("Quelle").Cells(X, 11)  
            Worksheets(Kriterium).Cells(Y, 12) = Worksheets("Quelle").Cells(X, 12)  
            Worksheets(Kriterium).Cells(Y, 13) = Worksheets("Quelle").Cells(X, 13)  
            Worksheets(Kriterium).Cells(Y, 14) = Worksheets("Quelle").Cells(X, 14)  
            Worksheets(Kriterium).Cells(Y, 15) = Worksheets("Quelle").Cells(X, 15)  
            Worksheets(Kriterium).Cells(Y, 16) = Worksheets("Quelle").Cells(X, 16)  
            Worksheets(Kriterium).Cells(Y, 17) = Worksheets("Quelle").Cells(X, 17)  
            Y = Y + 1
            
        End If
        
    Next X
    
    'Neue Mappe aufmachen und Tabellenblatt verschieben  
    Sheets(Kriterium).Move
    ActiveWorkbook.SaveAs Filename:=Pfad & "\" & Kriterium & ".xls", FileFormat:= _  
        xlNormal, CreateBackup:=False
    
    'Aktives Tabellenblatt schließen. Änderungen wurden bereits gespeichert!  
    ActiveWorkbook.Close
    
    'Nächste Runde  
    I = I + 1
    
Loop Until Worksheets("Pivot").Cells(I, 1) = "Gesamtergebnis"  

AW = MsgBox("Der Vorgang wurde abgeschlossen!", vbOKOnly + vbInformation + vbSystemModal, "Hinweis")  

Application.ScreenUpdating = True

End Sub



ich möchte jetzt jede Datei an eine spezielle e-mail-adresse verschicken z.B. Datei mit Kriterium A an email-adresse Y, Datei mit Kriterium B an email-adresse Z, usw.

ist das möglich, bzw. ist das mit einem makro möglich?
gelöstFrageMicrosoftMicrosoft Office
Mehr von simon-nisimon-niExchange Online Öffentliche Ordner EditOwnedItems funktioniert nichtsimon-nisimon-niPHP mail() Datei versendensimon-ni - 3 Kommentaresimon-niLogon Script wird trotz deaktivierung ausgeführtsimon-ni - 4 Kommentaresimon-niMicrosoft DNS URL forward zu IPsimon-ni - 2 Kommentare
Heiß diskutiert
NullcheckPortweiterleitung ist böse. tatsächlich? (Externzugriff auf Fritzbox)Nullcheck - 36 Kommentarem.sterZwei lokale Mailserver - Lösungsweg gesuchtm.ster - 30 KommentareSarekHLProblem mit SMB-Versionen?SarekHL - 24 Kommentareukulele-7Keine DNS-Auflösung auf bestimmte Domainukulele-7 - 22 KommentareMicitiEmpfehlung Hardware für Heim-NetzwerkMiciti - 22 KommentareMysticFoxDEIntel feuert Pat - Halleluja!MysticFoxDE - 21 KommentareJudgelgSharepoint Teams Kalender erstellenJudgelg - 21 KommentareVisuciusDevolutions Remote Desktop Manager - bin begeistert!Visucius - 15 KommentareBN2023Excel - Problem mit WENN-DANN Formel für eine VertretungsregelBN2023 - 15 KommentareGhent74Feste IP via DHCP im DHCP Bereich oder im statischen Bereich?Ghent74 - 14 KommentareGhent74Zwei Router, ein SubnetzGhent74 - 13 KommentareHaralabosHilfe bei E-Mail-Analyse: Absender einer anonymen Nachricht herausfindenHaralabos - 13 Kommentare