simon-ni
Mar 28, 2011 at 06:33:34 (UTC)
view6074
view5
0
Goto Top

Geöfnette Ecxel 2003 Datei per Makro versenden

GermansolvedQuestionMicrosoft OfficeMicrosoft
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
comment-contentCommentShareShare
Share on Facebook Share on Twitter Share on Reddit Share on Linkedin

Content-Key: 163437

Url: https://administrator.de/contentid/163437

Printed on: April 24, 2024 at 06:04 o'clock

5 Comments
Latest comment
Goto Top
Mitglied: 76109
76109 Mar 28, 2011 at 07:50:39 (UTC)
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
Mitglied: 83928
83928 Mar 28, 2011 at 08:29:04 (UTC)
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"
Member: simon-ni
simon-ni Mar 28, 2011 at 08:44:54 (UTC)
Goto Top
Funktioniert einwandfrei, danke
Member: simon-ni
simon-ni Mar 28, 2011 at 08:46:42 (UTC)
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.
Mitglied: 101993
101993 Aug 17, 2011 at 10:23:39 (UTC)
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?
GermansolvedQuestionMicrosoft OfficeMicrosoft
Hotly discussed
gleixnerdCheck of ZFW Firewallgleixnerd - 5 CommentsjstrickerWireguard VPN on UDM Pro behind Fritzbox - Handshake did not completejstricker - 3 CommentsAlexWishaHow to set up and configure a Linux GRE tunnelAlexWisha - 3 Comments