o0asia0o
Mar 10, 2017, updated at 08:36:58 (UTC)
view1128
view4
0
Goto Top

Mehrere Mail Vorlagen in VBA Skript verwenden

GermansolvedQuestionVB for ApplicationsDevelopment
Hallo zusammen

Ich würde gerne ein Skript anpassen, jedoch komme ich darauf nicht ganz klar..
Das Skript soll folgendes machen können:
Anhand des Standes eine Mailvorlage beziehen und die mailadresse und den Betreff jeweils anpassen, was in der Zeile steht. (siehe Bild unten)
bewerbung

Ich habe hier noch ein Skript, wo mir Colinardo geholfen/gemacht hat, was ziemlich ähnlich eigentlich ist, abgesehen vom Stand..
Ich weiss nicht wie ich den Befehl: "wenn Stand: Absage, beziehe Mailvorlage1", einfügen soll.

Skript:

Sub PrepareOutlookEmail()
    'Pfad zur Outlook-Vorlagendatei im OFT Format  
    Const TEMPLATEPATH = "U:\Firma\Vorlage.oft"  
    'Variablen  
    Dim objOL As Object, fso As Object, intCRow As Long, ws As Worksheet
    'Objekte  
    Set objOL = CreateObject("Outlook.Application")  
    Set fso = CreateObject("Scripting.FileSystemObject")  
    ' selektierte Zeile speichern  
    intCRow = Selection.Row
    ' aktuelles Sheet Variablen zuweisen  
    Set ws = ActiveSheet
    ' in der ausgewählten Zeile sollte mindestens eine AN-Adresse stehen  
    If ws.Cells(intCRow, "M").Value <> "" Then  
        ' Mail auf Basis der Vorlagendatei erstellen  
        With objOL.CreateItemFromTemplate(TEMPLATEPATH)
            'Eigenschaften der Mail mit den Daten im Sheet füllen  
            .To = ws.Cells(intCRow, "M").Value  
            .CC = ws.Cells(intCRow, "F").Value  
            '.BCC = ws.Cells(intCRow, "N").Value  
            .Subject = ws.Cells(intCRow, "O").Value  
            ' Prüfen ob Anhänge eingetragen sind  
            If ws.Cells(intCRow, "Q").Value <> "" Then  
                ' Mehrere Anhänge sollten mit einem "|" voneinander separiert werden,  
                For Each strAttachment In Split(ws.Cells(intCRow, "Q").Value, "|", -1, 1)  
                    ' Anhänge werden vor dem Hinzufügen auf Erreichbarkeit geprüft  
                    If fso.FileExists(Trim(strAttachment)) Then
                        .Attachments.Add Trim(strAttachment)
                    Else
                        MsgBox "ACHTUNG: Der Anhang '" & strAttachment & "' existiert nicht", vbExclamation, "Anhang hinzufügen"  
                    End If
                Next
            End If
            'Mail anzeigen  
            .Display
        End With
    Else
        MsgBox "Es wurde keine gültige Zeile selektiert", vbExclamation  
    End If
    'Cleanup  
    Set objOL = Nothing
    Set fso = Nothing
End Sub
comment-contentCommentShareShare
Share on Facebook Share on Twitter Share on Reddit Share on Linkedin

Content-Key: 331769

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

Printed on: April 18, 2024 at 22:04 o'clock

4 Comments
Latest comment
Goto Top
Member: emeriks
emeriks Mar 10, 2017 at 08:04:31 (UTC)
Goto Top
Hi,
ich glaube, es wird für die Kollegen/innen viel einfacher werden, Dir zu helfen, wenn Du den Code mit Code-Tags versiehst.

E.
Member: o0Asia0o
o0Asia0o Mar 10, 2017 at 08:37:34 (UTC)
Goto Top
So habe es angepasst face-smile hoffe ist nun einfacher
Mitglied: 132658
Solution 132658 Mar 10, 2017 updated at 09:42:02 (UTC)
Goto Top
Hi.
Da bietet sich ja ein "Select Case" an:
Sub PrepareOutlookEmail()
    'Variablen  
    Dim objOL As Object, fso As Object, intCRow As Long, ws As Worksheet, TemplatePath as String
    'Objekte  
    Set objOL = CreateObject("Outlook.Application")  
    Set fso = CreateObject("Scripting.FileSystemObject")  
    ' selektierte Zeile speichern  
    intCRow = Selection.Row
    ' aktuelles Sheet Variablen zuweisen  
    Set ws = ActiveSheet
    
    Select Case ws.Cells(intCRow,"P")  
        Case "Absage"  
          TemplatePath = "U:\Firma\Vorlage1.oft"  
        Case "Interview"  
          TemplatePath = "U:\Firma\Vorlage2.oft"  
        Case "Zusage"  
          TemplatePath = "U:\Firma\Vorlage3.oft"  
        Case Else
           TemplatePath = "U:\Firma\AllgemeineVorlage.oft"  
    End Select
    ' in der ausgewählten Zeile sollte mindestens eine AN-Adresse stehen  
    If ws.Cells(intCRow, "M").Value <> "" Then  
        ' Mail auf Basis der Vorlagendatei erstellen  
        With objOL.CreateItemFromTemplate(TemplatePath)
            'Eigenschaften der Mail mit den Daten im Sheet füllen  
            .To = ws.Cells(intCRow, "M").Value  
            .CC = ws.Cells(intCRow, "F").Value  
            '.BCC = ws.Cells(intCRow, "N").Value  
            .Subject = ws.Cells(intCRow, "O").Value  
            ' Prüfen ob Anhänge eingetragen sind  
            If ws.Cells(intCRow, "Q").Value <> "" Then  
                ' Mehrere Anhänge sollten mit einem "|" voneinander separiert werden,  
                For Each strAttachment In Split(ws.Cells(intCRow, "Q").Value, "|", -1, 1)  
                    ' Anhänge werden vor dem Hinzufügen auf Erreichbarkeit geprüft  
                    If fso.FileExists(Trim(strAttachment)) Then
                        .Attachments.Add Trim(strAttachment)
                    Else
                        MsgBox "ACHTUNG: Der Anhang '" & strAttachment & "' existiert nicht", vbExclamation, "Anhang hinzufügen"  
                    End If
                Next
            End If
            'Mail anzeigen  
            .Display
        End With
    Else
        MsgBox "Es wurde keine gültige Zeile selektiert", vbExclamation  
    End If
    'Cleanup  
    Set objOL = Nothing
    Set fso = Nothing
End Sub
Guß schnappi
Member: o0Asia0o
o0Asia0o Mar 10, 2017 at 10:25:58 (UTC)
Goto Top
Super danke dir Schnappi es funktioniert einwandfrei face-smile
GermansolvedQuestionVB for ApplicationsDevelopment
Hotly discussed
AlexWishaHow to set up and configure a Linux GRE tunnelAlexWisha - 3 CommentsjstrickerWIREGUARD VPN ON UDM PRO BEHIND FRITZBOX - HANDSHAKE DID NOT COMPLETEjstricker - 1 CommentDaniEnd of Support dates for Office 2016, 2019 Apps und Productivity ServersDani - 1 Comment