Live-Forum - Die aktuellen Beiträge
Datum
Titel
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
1712to1716
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
Inhaltsverzeichnis

verschiedene Maillisten je Auswahl aufrufen

verschiedene Maillisten je Auswahl aufrufen
01.10.2019 10:15:26
Dennis
Hallo,
ich bräuchte noch einmal eure Hilfe, da die Recherche und meine Versuche keinen Erfolg bringen...
Als letzte Verbesserung in meinem Programm, möchte ich den richtigen Verteiler beim Email versenden auswählen. Dieser ist abhängig, welche Checkbox ich in der Userform ausgewählt habe.
Bsp.
Bei Checkbox3 stehen die Adressen im Reiter "Daten" in Spalte D2 bis Dx (sollte am besten dynamisch sein)
Bei Checkbox4 stehen die Adressen im Reiter "Daten" in Spalte E2 bis Ex
Baue ich dieses in die jeweiligen Call Funktionen Bonus und Zeiten ein? Also irgendwie so:
listBonus=...
listZeiten=...
und rufe diese dann später in der Funktion Mail_senden ab?
.To = listBonus
Wie müssten der/die Code sein?
Vielen Dank für eure Hilfe
Private Sub CommandButton1_Click()
Dim Ordner As String
Ordner = ThisWorkbook.Path & "\Ablage"
Application.ScreenUpdating = False
If CheckBox3.Value = True Then
Call Bonus
Else: End If
If CheckBox4.Value = True Then
Call Zeiten
Else: End If
Call Mail_senden
End Sub

Sub Bonus()
With Worksheets("Sheet3")
.Range("$A$2:$AI$" & .Cells(.Rows.Count, "A").End(xlUp).Row).AutoFilter _
Field:=1, Criteria1:="*Bonus*"
With .AutoFilter.Range
.Columns("A:B").Offset(1).Resize(.Rows.Count - 1).Copy
Worksheets("Bonus").Range("N7").PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False
End With
If .AutoFilterMode Then .AutoFilterMode = False
Sheets("Bonus").Visible = True
Pfad = ThisWorkbook.Path & "\" & "Ablage\" & Format(Date, "YYMMDD_") & "Bonus"
Worksheets("Bonus").ExportAsFixedFormat Type:=xlTypePDF, Filename:=Pfad, _
Quality:=xlQualityStandard, IncludeDocProperties:=True, _
IgnorePrintAreas:=False, OpenAfterPublish:=False
Sheets("Bonus").Visible = False
End With
End Sub

Sub Zeiten()
With Worksheets("Sheet3")
.Range("$A$2:$AI$" & .Cells(.Rows.Count, "A").End(xlUp).Row).AutoFilter _
Field:=1, Criteria1:="*Zeiten*"
With .AutoFilter.Range
.Columns("A:B").Offset(1).Resize(.Rows.Count - 1).Copy
Worksheets("Zeiten").Range("N7").PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False
End With
If .AutoFilterMode Then .AutoFilterMode = False
Sheets("Zeiten").Visible = True
Pfad = ThisWorkbook.Path & "\" & "Ablage\" & Format(Date, "YYMMDD_") & "Zeiten"
Worksheets("Zeiten").ExportAsFixedFormat Type:=xlTypePDF, Filename:=Pfad, _
Quality:=xlQualityStandard, IncludeDocProperties:=True, _
IgnorePrintAreas:=False, OpenAfterPublish:=False
Sheets("Zeiten").Visible = False
End With
End Sub

Sub Mail_senden()
Const FOLDER_PATH As String = "C:\Users\"
Dim objOutlook As Object, objMail As Object
Dim strFilename As String, astrAttachment() As String
Dim ialngIndex As Long
strFilename = Dir$(FOLDER_PATH & "*.pdf")
Do Until strFilename = vbNullString
ReDim Preserve astrAttachment(ialngIndex)
astrAttachment(ialngIndex) = FOLDER_PATH & strFilename
ialngIndex = ialngIndex + 1
strFilename = Dir$
Loop
Set objOutlook = CreateObject(Class:="Outlook.Application")
Set objMail = objOutlook.CreateItem(0)
With objMail
.To = "max.mustermann@de.com"
.Subject = "Test"
.Body = "Sehr geehrte Damen und Herren," & vbLf & vbLf & "Hier die Daten "
For ialngIndex = LBound(astrAttachment) To UBound(astrAttachment)
Call .Attachments.Add(astrAttachment(ialngIndex))
Next
Call .Display
End With
Set objMail = Nothing
Set objOutlook = Nothing
End Sub

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

Betreff
Datum
Anwender
Anzeige
AW: verschiedene Maillisten je Auswahl aufrufen
02.10.2019 11:37:26
Dennis
Hat keiner eine Idee. Ich hänge hier leider.
Viele Grüße
AW: verschiedene Maillisten je Auswahl aufrufen
02.10.2019 12:50:56
ChrisL
Hi Dennis
Exemplarisch...
Private Sub CommandButton1_Click()
Dim arrEmpfaenger As Variant
With Worksheets("Tabelle1")
If CheckBox3.Value = True Then
arrEmpfaenger = .Range("D2:D" & .Cells(Rows.Count, 4).End(xlUp).Row)
Call Bonus
ElseIf CheckBox4.Value = True Then
arrEmpfaenger = .Range("E2:E" & .Cells(Rows.Count, 5).End(xlUp).Row)
Call Zeiten
Else
Exit Sub
End If
End With
Call Mail_senden(Join(Application.Transpose(arrEmpfaenger), ", "))
End Sub
Sub Mail_senden(strEmpfaenger As String)
MsgBox strEmpfaenger
End Sub
cu
Chris
Anzeige

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige