Thema Datum  Von Nutzer Rating
Antwort
Rot Makro - Anlagen versenden falls vorhanden
10.09.2020 11:30:05 Jasmin
NotSolved
10.09.2020 14:45:58 Volti
NotSolved
10.09.2020 14:56:07 Gast82500
NotSolved
10.09.2020 20:26:51 Gast65509
NotSolved

Ansicht des Beitrags:
Von:
Jasmin
Datum:
10.09.2020 11:30:05
Views:
99
Rating: Antwort:
  Ja
Thema:
Makro - Anlagen versenden falls vorhanden

Hallo zusammen, 

 

folgendes Problem: ich habe ein Makro aufgesetzt durch welches automatisiert eine Mail verschickt werden soll. In Spalte B ist die Anrede in Spalte C der Empfänger, in D cc, in E der Betreff. Danach folgen die Anlagen. Mein Problem besteht nun im folgenden: zum einen möchte ich mehrere Spalten bei den Anlagen mitaufnehmen (bis Spalte Z) und falls Spalten leer sind, es also keine Anlagen gibt, soll die Mail trotzdem eben versendet werden. Hier mein Makro:

 

Sub Mails_SendenLtList()
'Sub sendet Mails lt. Liste
'Anlagen kommagetrennt oder per Zeilenumbruch CHR(10)
'Mit oder ohne Pfadangabe
 Dim WSh As Worksheet, sDatei() As String, sTxt As String
 Dim sPfad As String, sMailtext As String, sSig As String
 Dim iZeile As Long, i As Long
 Dim oMail As Object, sAnl As String
 
 
 Set WSh = Worksheets("Tabelle1")                'Mail-Blatt festlegen
 
 With CreateObject("Outlook.Application")
  
  For iZeile = 2 To WSh.UsedRange.Rows.Count     'Liste der Mails durchgehen
   If WSh.Cells(iZeile, "C").Value <> "" Then    'Mindestens Mail-Adresse muss ausgefüllt sein
    Set oMail = .CreateItem(0)                   'Mail kreieren
    
    With oMail
      .Getinspector: sSig = .htmlbody            'Signatur holen
      .To = WSh.Cells(iZeile, "C").Value         'Adresse
      .cc = WSh.Cells(iZeile, "D").Value         'Kopieempfänger
      .Subject = WSh.Cells(iZeile, "E").Value    'Betreffzeile
      
      sMailtext = "<span style='font-size:13pt;font-family:Arial;color:#000000;'>" _
                & WSh.Cells(iZeile, "B").Value & "<br><br>" _
                & "anbei senden wir Ihnen den unterzeichneten Dienstleistungsrahmenvertrag.<br><br>" _
                & "Bei Fragen melden Sie sich gerne bei uns.<br>" _
                & "</span>"
      
      sAnl = WSh.Cells(iZeile, "F").Value & "," _
           & WSh.Cells(iZeile, "G").Value        'Anlage(n) mit/ohne Pfad
      
      If sAnl <> "" Then                         'Anlagen anfügen
        sDatei = Split(Replace(sAnl, vbLf, ","), ",")
        
        For i = 0 To UBound(sDatei)
          If InStr(sDatei(i), ":") = 0 Then
             sDatei(i) = sPfad & sDatei(i)       'Pfad vorsetzen
          End If
          If Dir(sDatei(i)) <> "" Then          'Anlage(n) anfügen
             .attachments.Add sDatei(i)
          End If
        Next i
      
      End If
      
      .htmlbody = Replace(sMailtext, "~", "") & sSig 'Body-Text, Signatur einfügen
      .send
    
    End With
    
    Set oMail = Nothing                          'Objekt-Variable zurücksetzen
    WSh.Cells(iZeile, "I").Value = "Gesendet"    'Als gesendet markieren
    
   End If
  Next iZeile
 
 End With
 
 
End Sub
 
 
Danke!

 


Ihre Antwort
  • Bitte beschreiben Sie Ihr Problem möglichst genau und ausführlich
  • Codeschnipsel am besten über den Code-Button im Text-Editor einfügen
  • Die Angabe der Emailadresse ist freiwillig und wird nur verwendet, um Sie bei Antworten auf Ihren Beitrag zu benachrichtigen
  • Bitte markieren Sie Ihre Anfrage als erledigt wenn Ihnen geholfen wurde
Thema: Name: Email:

 
 

Thema Datum  Von Nutzer Rating
Antwort
Rot Makro - Anlagen versenden falls vorhanden
10.09.2020 11:30:05 Jasmin
NotSolved
10.09.2020 14:45:58 Volti
NotSolved
10.09.2020 14:56:07 Gast82500
NotSolved
10.09.2020 20:26:51 Gast65509
NotSolved