Microsoft Excel

Herbers Excel/VBA-Archiv

Informationen und Beispiele zum Thema CheckBox
BildScreenshot zu CheckBox CheckBox-Seite mit Beispielarbeitsmappe aufrufen
Informationen und Beispiele zum Thema MsgBox
BildScreenshot zu MsgBox MsgBox-Seite mit Beispielarbeitsmappe aufrufen
Informationen und Beispiele zum Thema CommandButton
BildScreenshot zu CommandButton CommandButton-Seite mit Beispielarbeitsmappe aufrufen
Informationen und Beispiele zum Thema Userform
BildScreenshot zu Userform Userform-Seite mit Beispielarbeitsmappe aufrufen

verschiedene Maillisten je Auswahl aufrufen


Betrifft: verschiedene Maillisten je Auswahl aufrufen von: Dennis
Geschrieben am: 01.10.2019 10:15:26

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

  

Betrifft: AW: verschiedene Maillisten je Auswahl aufrufen von: Dennis
Geschrieben am: 02.10.2019 11:37:26

Hat keiner eine Idee. Ich hänge hier leider.

Viele Grüße


  

Betrifft: AW: verschiedene Maillisten je Auswahl aufrufen von: ChrisL
Geschrieben am: 02.10.2019 12:50:56

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


Beiträge aus dem Excel-Forum zum Thema "verschiedene Maillisten je Auswahl aufrufen"