Juni 21, 2021, 03:48:56

Neuigkeiten:

Ist euer Problem gelöst, dann bitte den Knopf "Thema gelöst" drücken!


Mail Konto festlegen

Begonnen von martenk, Mai 26, 2021, 11:29:10

⏪ vorheriges - nächstes ⏩

martenk

Mai 26, 2021, 11:29:10 Letzte Bearbeitung: Mai 26, 2021, 11:39:33 von martenk
Hallo,

ich verwende dieses Script zum Mailversand aus Access - das klappt auch alles - nur habe ich mehrere Mail Accounts eingerichtet und das Script verwendet einen falschen Mail Account - wo kann ich das einstellen?

LG

Function Senden_Html()
Dim objOutlook As Outlook.Application
Dim objOutlookMsg As Outlook.MailItem
Dim objOutlookRecip As Outlook.Recipient
Dim Betreff As String: Betreff = "Ihr Monatlicher Bericht"
Dim Nachricht As String, an As String, ATT1
Dim db As Database, rs As Recordset
Dim html
 
  'DoCmd.Echo False, "Visual Basic-Code wird ausgeführt."
  'Verzeichnis erstellen und Berichte reinschieben
 
 
  'Berichte ausgeben
  'Der dritte Bericht wird im HTML- Format als Textdatei gespeichert
  'Es müssen keine Berichte sein, wenn was anderes gewünscht wird, in die Hilfe vom "OutputTo" schauen.
  'DoCmd.OutputTo acOutputQuery, "Abfrage1", "CSV(*.csv)", "C:\temp\Ber_verz\Bericht1.csv", False, ""
  'DoCmd.OutputTo acReport, "Bericht2", "RichTextFormat(*.rtf)", "C:\temp\Ber_verz\Bericht2.rtf", False, ""
 ' DoCmd.OutputTo acReport, "InfoDateneingabe", "HTML(*.html)", "C:\1\test.docx", False, ""
  ATT1 = "C:\1\Ahlers.docx"
  'ATT2 = "C:\temp\Ber_verz\Bericht2.rtf"
  'Quelltext vom dritten Bericht einlesen.
  Nachricht = readTxtFile("C:\1\test.docx")
 
 
 
    html = "<!DOCTYPE html><html><body>"
    html = html & "<div style=""font-family:'Segoe UI', Calibri, Arial, Helvetica; font-size: 14px; max-width: 500px;"">"
    html = html & "<p align='right'><img src='http://test.de/Bilder/logo.png'></p>"
    html = html & "Dear {name}, <br /><br />This is a test email from MS Access using VBA. <br />"
    html = html & "Here is current recordset data:<br /><br />"
    html = html & "<table style='border-spacing: 0px; border-style: solid; border-color: #ccc; border-width: 0 0 1px 1px;'>"
 

        html = html & "<tr>"
        html = html & "<td style='padding: 10px; border-style: solid; border-color: #ccc; border-width: 1px 1px 0 0;'>Name</td>"
        html = html & "<td style='padding: 10px; border-style: solid; border-color: #ccc; border-width: 1px 1px 0 0;'>Test</td>"
        html = html & "<td style='padding: 10px; border-style: solid; border-color: #ccc; border-width: 1px 1px 0 0;'>Neu</td>"

        html = html & "</tr>"

   

    html = html & "</table></div></body></html>"
 
 
 
 
 
 
  'Mailobjekt erstellen
  Set objOutlook = CreateObject("Outlook.Application")
  Set objOutlookMsg = objOutlook.CreateItem(0)
 
  'Tabelle "Verteiler" auslesen.
  Set db = CurrentDb
  Set rs = db.OpenRecordset("Verteiler", dbOpenDynaset)
  DoCmd.Echo True
  If rs.EOF Then MsgBox "Keine Empfänger im Verteiler", vbExclamation: GoTo Ex
 
  With objOutlookMsg
    'Durch alle Empfänger
    Do While Not rs.EOF
      an = Nz(rs!Name, "")
      If an <> "" Then .Recipients.Add an
      rs.MoveNext
    Loop
   'Inhalt des Mails festlegen
    .Importance = 0 ' niedrige priorität
    .Subject = Betreff
    .HTMLBody = html   'HTML-Format
    .Attachments.Add ATT1 'Berichte anhängen
    '.Attachments.Add ATT2
    For Each objOutlookRecip In .Recipients
      objOutlookRecip.Resolve 'Namen überprüfen
    Next
    '.Display 'Nachricht wird angezeigt
    .Send   'Nachricht wird sofort gesendet
  End With

Ex:
  On Error Resume Next
  rs.Close
  Set objOutlook = Nothing
  'Verzeichnis und Dateien werden gelöscht
  Kill "C:\temp\Ber_verz\*.*"
  Kill "C:\temp\Beispiel.txt"
  RmDir "C:\temp\Ber_verz"
  Exit Function
 
Er:
  MsgBox Err.Description
  Resume Ex
End Function

PhilS

Zitat von: martenk am Mai 26, 2021, 11:29:10ich verwende dieses Script zum Mailversand aus Access - das klappt auch alles - nur habe ich mehrere Mail Accounts eingerichtet und das Script verwendet einen falschen Mail Account - wo kann ich das einstellen?
Siehe: SendUsingAccount - Email über bestimmten Account versenden
Access DevTools - Find and Replace
Komfortables Suchen und Ersetzen in den Entwurfseigenschaften von Access-Objekten. In Abfragen, Formularen, Berichten und VBA-Code - Überall und rasend schnell!

martenk

lieben Dank - kannst du mir bitte helfen beim Einbau in das Script

markus888

Zitat von: martenk am Mai 26, 2021, 15:57:20lieben Dank - kannst du mir bitte helfen beim Einbau in das Script

Was ist denn dein konkretes Problem?
Geht ja nur um eine einzige Anweisung.
Hast du schon mal die Hilfe zu dem was du nicht verstehst angesehen?
10 Jahre Access

martenk

sorry - vergessen einzutragen - hatte es in der hilfe gefunden