Live-Forum - Die aktuellen Beiträge
Datum
Titel
17.05.2024 20:08:47
Datum/Zeit in einer Zelle fixieren über Makros
17.05.2024 18:14:48
Aaaah! Tabelle erstellen mit Index
17.05.2024 17:37:33
letztes Zeichen in Zelle entfernen
17.05.2024 17:07:32
Problem bei Diagrammerstellung
Du findest keine passende Antwort auf Deine Frage?
Stelle Deine Frage in unserem Live-Forum
Anzeige
Archiv - Navigation
1960to1964
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
Vorheriger Thread
Vorheriger Thread
Rückwärts Blättern
1960to1964
1960to1964
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Nächster Thread
Nächster Thread
Vorwärts blättern
Inhaltsverzeichnis

Formel straffen

Formel straffen
22.01.2024 13:52:18
tobi
Hallo,

ich habe eine Datei in der mittels eines Makros ein PDF erzeugt und dann per Outlook an mehrere Empfänger verschickt wird.
Die Empfänger stehen in den Zellen S2, S3, S4 usw.

Der dazugehörige Eintrag im makro lautet: 

.To = Tabelle10.Range("S2").Value & ";" & Tabelle10.Range("S3").Value & ";" & Tabelle10.Range("S4").Value & ";" & Tabelle10.Range("S5").Value


Wenn jetzt nicht nur vier Empfänger (wie im Beispiel) sondern etwa 35 angeschrieben werden, dann wird diese Formel sehr schnell unübersichtlich lang.

Kann man den Ausdruck irgendwie straffen dass alle email-Adressen von (z.B.) Zelle s2:s50 in die Adressleiste von Outlook übergeben werden?

Vielen Dank im Voraus
tobi

7
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Formel straffen
22.01.2024 14:09:52
Der Steuerfuzzi
Hallo,

evtl. so: 
.To = Join(WorksheetFunction.Transpose(Tabelle10.Range("S2:S5")), ";")


Grüße
Michael
AW: Formel straffen
22.01.2024 14:24:53
daniel
HI
mit Excel 2019

.To = Worksheetfunction.TextJoin(";", true, Tabelle10.Range("S2:S50"))

Gruß Daniel
AW: Formel straffen
22.01.2024 15:17:41
tobi
Leider haben Eure beiden Vorschläge nicht ganz zum Ziel geführt. Statt der eMail-Adressen steht in der Adresszeile nur
3.; 6; 13; 17; 9; 16; 11; 12; 8; 13; 13; 11; 6; 10; 11; 13; 9; 19; 13; 11; 7; 14; 13; 15; 18; 13; 9; 14; 12; 9; 12; 12; 15; 12; 12; 9; 14; 13; 17; 9; 9

Woran könnte das liegen...?

Soll ich mal den kompletten Makrocode veröffentlichen...?

tobi
Anzeige
AW: Formel straffen
23.01.2024 10:22:40
Der Steuerfuzzi
Hallo,

Du schreibst:
Die Empfänger stehen in den Zellen S2, S3, S4 usw.
Dein Makro lautet derzeit (und funktioniert): 
.To = Tabelle10.Range("S2").Value & ";" & Tabelle10.Range("S3").Value & ";" & Tabelle10.Range("S4").Value & ";" & Tabelle10.Range("S5").Value


Wenn das alles so stimmt, müssten die Codes von Daniel und mir funktionieren und nicht eine Zahlenkolonne ausgeben, da beide Lösungen den gleichen Bereich verwenden, den Du auch angibst. Entweder hast Du auf das falsche Blatt Bezug genommen oder in den Zellen S2, S3, usw. stehen keine Mailadressen. In diesem Fall nützt Dein kompletter Code leider auch nichts, da sich daraus für das konkrete Problem keine Informationen ergeben. Es wäre interessanter, die Datei, die Tabellen und deren Inhalt zu kennen.

Also prüfe mal, ob Du beim Testen auch die korrekte Tabelle ansprichst.

Grüße
Michael
Anzeige
AW: Formel straffen
22.01.2024 18:13:19
Yal
Hallo Tobi,

im Prinzip so: 

Sub MailEmpfänger_hinzufügen()

Dim S As Outlook.Namespace

Dim M As MailItem

Dim Z

Dim R As Recipient



    Set S = Outlook.GetNamespace("MAPI")

    Set M = Outlook.CreateItem(olMailItem)

    With M.Recipients

        For Each Z In Range("S2:S50")

            If Z.Value > "" Then

                Set R = .Add(Z.Value)

                R.Type = olTo 'olCC, olBCC

            End If

        Next

    End With

End Sub


In der Onlinehilfe ( https://learn.microsoft.com/de-de/office/vba/api/outlook.recipient ) gibt es leider wenige und unvollständige Beispiele.

VG
Yal
Anzeige
AW: Formel straffen
23.01.2024 08:23:10
tobi
ich habe hier mal den kompletten Code des Makros. 

Sub ExcelDateiSendenSendenDienst()

Dim Nachricht As Object

Dim Account As Object

Dim OutApp As Object

Set OutApp = CreateObject("Outlook.Application")

Dim AWS As String

'Aktive Arbeitsmappe wird als Mail gesendet



AWS = "c:\testordner_001\2023\Januar\" & "Aktuelle Abrechnung" & ".pdf"

ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=AWS, quality:=xlQualityStandard, ignoreprintareas:=False

Set Nachricht = OutApp.CreateItem(0)

With Nachricht

.SentOnBehalfOfName = "max.mustermann@xyz.de"

.To = Tabelle10.Range("S2").Value & ";" & Tabelle10.Range("S3").Value & ";" & Tabelle10.Range("S4").Value & ";" & Tabelle10.Range("S5").Value & ";" & Tabelle10.Range("S6").Value & ";" & Tabelle10.Range("S7").Value & ";" & Tabelle10.Range("S8").Value & ";" & Tabelle10.Range("S9").Value & ";" & Tabelle10.Range("S10").Value & ";" & Tabelle10.Range("S11").Value

.BCC = Tabelle10.Range("S14").Value & ";" & Tabelle10.Range("S15").Value & ";" & Tabelle10.Range("S16").Value & ";" & Tabelle10.Range("S17").Value & ";" & Tabelle10.Range("S18").Value & ";" & Tabelle10.Range("S19").Value & ";" & Tabelle10.Range("S20").Value & ";" & Tabelle10.Range("S21").Value & ";" & Tabelle10.Range("S22").Value & ";" & Tabelle10.Range("S23").Value

.Subject = "Aktuelle Abrechnung"

.attachments.Add AWS

.Body = "Hallo zusammen," & vbCrLf & vbCrLf & "als Anlage die aktuelle Abrechnung." & vbCrLf & vbCrLf & "LG" & vbCrLf & "Max"

End With

For Each Account In OutApp.session.accounts

        If Account.DisplayName = max.mustermann@xyz.de Then

            Set Nachricht.SendUsingAccount = Account

            'Hier wird die Mail nochmals angezeigt

            Nachricht.Display

            'Hier wird die Mail gleich in den Postausgang gelegt

            'Nachricht.Send

        End If

    Next

    'Outlook schliessen

    'OutApp.Quit

    Set OutApp = Nothing

    Set Nachricht = Nothing

End Sub


und da müsste halt die .To und die .BCC Zeile entsprechend angepasst werden...

Danke
tobi
Anzeige
AW: Formel straffen
23.01.2024 14:02:30
Yal
Hallo Tobi, 

Sub ExcelDateiSendenSendenDienst()

'Unter Anbindung der Bibliotheken (VB-Editor, Extras, Verweise):

' Microsoft Outlook 19.0 Object Library

Dim NameSp As Outlook.Namespace

Dim Nachricht As Outlook.MailItem

Dim AWS As String

Dim Z As Range

Dim R As Recipient



'Aktive Arbeitsmappe wird als Mail gesendet

    AWS = "c:\testordner_001\2023\Januar\" & "Aktuelle Abrechnung" & ".pdf"

    ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=AWS, quality:=xlQualityStandard, ignoreprintareas:=False

    Set NameSp = Outlook.GetNamespace("MAPI") '

    Set Nachricht = NameSp.CreateItem(olMailItem)

    With Nachricht

        .SentOnBehalfOfName = "max.mustermann@xyz.de"

        For Each Z In Tabelle10.Range("S2:S11")

            If Z.Value > "" Then

                Set R = .Recipients.Add(Z.Value)

                R.Type = olTo

            End If

        Next

        For Each Z In Tabelle10.Range("S14:S23")

            If Z.Value > "" Then

                Set R = .Recipients.Add(Z.Value)

                R.Type = olBCC

            End If

        Next

        .Subject = "Aktuelle Abrechnung"

        .attachments.Add AWS

        .Body = "Hallo zusammen," & vbCrLf & vbCrLf & "als Anlage die aktuelle Abrechnung." & vbCrLf & vbCrLf & "LG" & vbCrLf & "Max"

    End With

    For Each Account In OutApp.session.accounts

        If Account.DisplayName = "max.mustermann@xyz.de" Then

            Set Nachricht.SendUsingAccount = Account

            Nachricht.Display 'Hier wird die Mail nochmals angezeigt

            'Nachricht.Send 'Hier wird die Mail gesendet (und als Nebeneffekt im "Send"-Folder abgelegt)

        End If

    Next

    Set NameSp = Nothing

    Set Nachricht = Nothing

End Sub


VG
Yal
Anzeige

Links zu Excel-Dialogen

Frame

Beliebteste Forumthreads (12 Monate)

Anzeige
Jetzt das Excel-Portal bewerten: Deine Stimme zählt!

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige