Office: (Office 2010) Wie Performance verbessern?

Atrus2711 · 14. November 2011

Ein Plan wurde ja mehrfach angefordert. Er wird nur nicht gezeigt... also muss er rausgepopelt werden. Kann was dauern....

Wenn ein Kundiger danebensäße, würden sich wohl noch ganz andere Wege ergeben.

User · 14. November 2011

\@ebs17
Ich verfolge auch gespannt*wink.gif*

Vor allem die Diskussion zu SQL und Recordset!
Mir scheint, mille81 hat Martin schon ganz "kirre" gemacht! *Smilie

Gruß

LL

mille81 · 14. November 2011

\@Marsu65: Der Versand via Word/Bericht. Weils immer ein anderer Bericht wäre.

Was heißt Plan wurde angefordert? Wo denn... habs doch eigentlich ganz gut beschrieben, ging ja auch mehr ums Allgemeine

Kirre mach ich gerne, dann machts doch erst Spass ;-)

Naja also ich schreibs aber gern nochmal zusammen.

Ausgangstabelle ist: NL_tbl_pers_nl
Dort stehen alle Empfänger mit Ihren Daten (Email, Welche Themen sind abonniert, etc.) drinnen.

Dann gibt es eine Veranstaltung dessen Haupttabelle die tbl_veranst ist.
Dort sind alle Daten zur Veranstaltung enthalten. Verknüpft sind diese z.B. mit der tbl_kategorien (Themen) und der tbl_belegung (Termine der Veranstaltung) usw.

Aus einem Formular heraus versende ich einen individuellen Newsletter (in meinem Fall eine Einladun) an jeden Teilnehmer, je nachdem welche Themen er abonniert hat und welche Themenfelder die Veranstaltung hat.

Den Newsletter wie er nachher aussieht hatte ich ja als pdf angehängt.

Der Code des Versandbuttons sieht jetzt optimiert wie folgt aus (der erzeugt eine HTML Outlook 2010 optimierte Mail an den Empfänger, ich weiß der HTML Code sieht schlimm aus, aber das ist das einzige was Outlook 2010 akzeptiert (Word Interpreter) ):
Code:

Private Sub send_nl_Click()
Dim hauptkat As String
Dim kattext As String
Dim mailadresse As String
Dim betreff As String
Dim titel As String
Dim vformat As String
Dim vformat_alt As String
Dim mailtext As String
Dim mt0 As String
Dim mt1 As String
Dim mt2 As String
Dim mt3 As String
Dim mt4 As String
Dim mt5 As String
Dim mt6 As String
Dim mt7 As String
Dim mt8 As String
Dim mt9 As String
Dim mt10 As String
Dim mt10a As String
Dim kurzbesch As String
Dim ablauf As String
Dim zielgruppe As String
Dim interessenten As String
Dim Ort As String
Dim kosten As String
Dim personenfilter As String
Dim intern As String
Dim logo As String
Dim Anrede As String
Dim att As String
Dim i As Integer
Dim j As Integer
Dim k1 As Integer
Dim k2 As Integer
Dim VID As Integer

VID = Me!ID_VE

'##############Allgemeiner Teil für alle User BEGINN ##############
'Kategorien der Veranstaltung bestimmen
Set dat3 = CurrentDBC.OpenRecordset("SELECT tbl_veranst_uf_kat.VE_ID, tbl_veranst_uf_kat.K_ID, tbl_veranst_uf_kat.hauptkat, tbl_kategorien.kurzname, tbl_kategorien.name FROM tbl_kategorien INNER JOIN tbl_veranst_uf_kat ON tbl_kategorien.K_ID = tbl_veranst_uf_kat.K_ID WHERE tbl_veranst_uf_kat.VE_ID=" & VID & " ORDER BY tbl_veranst_uf_kat.K_ID")

'Kategorien inklusive Hauptkategorie der Veranstaltung bestimmen
i = 0
Do Until dat3.EOF

If dat3!hauptkat = False Then
If kat = "" Then kat = dat3!name Else kat = kat & ", " & dat3!name
'Bestimmung der Hauptkategorie (Themen der Mustermann AG)
Else: hauptkat = dat3!name
End If
i = i + 1
dat3.MoveNext
Loop

'Textbaustein erzeugen
'mehrere weitere Kategorien?
If i > 1 Then
kattext2 = "folgenden Themenn"
Else
kattext2 = "folgendem Themenn"
End If

If kat = "" Then
kattext = "Diese Veranstaltung ist dem Thema " & hauptkat & " der Mustermann AG zugeordnet."
Else
kattext = "Diese Veranstaltung ist neben dem Thema " & hauptkat & " der Mustermann AG noch " & kattext2 & " zugeordnet: " & kat & "."
End If

'Mustermann AG-Format bestimmen
vformat = DLookup("art", "tbl_format", "id_va = " & Me!ID_VA)

'Format für Einladungstext umformulieren
Select Case vformat
Case "Programm"
vformat_alt = "zum Programm "
Case "Konferenz"
vformat_alt = "zu der Konferenz "
Case "Vortrag"
vformat_alt = "zum Vortrag "
Case "Seminar"
vformat_alt = "zum Seminar "
End Select

'stylesheet
mt0 = "<style type = 'text/css'> td {font-family:Arial;font-size:10pt;}" & _
"span {font-family:Arial; font-size:10pt; line-height:14pt}" & _
"ul {margin-top:2pt; margin-bottom:2pt} p {margin-top:2pt; margin-bottom:4pt}" & _
"table {table-layout: fixed;} " & _
"a:link, a:visited {color:#990033}</style>"

'Betreff
betreff = "Die Mustermann AG lädt ein: '" & Me!name & "'"

'Mustermann AG lädt zur Veranstaltung ein
mt2 = "<tr><td style='width:600px'colspan='4'>die Mustermann AG lädt Sie herzlich " & vformat_alt & """ & Me!name & "" ein.</td></tr>"

'Newslettertext
mt3 = "<tr><td style='width:600px' colspan='4'>" & Me!txt_newsletter & "</td></tr>"

'Zielgruppe
mt7 = "<tr><td style=width:600px;border:none;padding:2pt 5.4pt 2pt 5.4pt' colspan='4'>Bitte beachten Sie auch Folgendes:</td></tr><tr><td style='width:130px;background:#cdcdcd;mso-background-themecolor:background1;mso-background-themeshade:217;border:none;padding:2pt 5.4pt 2pt 5.4pt' valign='top' colspan='1'>Zielgruppe:</td><td style='width:470px;background:#e5e5e5;mso-background-themecolor:background1;mso-background-themeshade:242;border:none;padding:2pt 5.4pt 2pt 5.4pt' colspan='3'>" & Me!zielgruppe & "</td></tr>"

'Anmeldeschluss
mt8 = "<tr><td style='width:130px;;background:#cdcdcd;mso-background-themecolor:background1;mso-background-themeshade:217;border:none;padding:2pt 5.4pt 2pt 5.4pt' valign='top' colspan='1'>Anmeldeschluss:<td style='width:470px;background:#e5e5e5;mso-background-themecolor:background1;mso-background-themeshade:242;border:none;padding:2pt 5.4pt 2pt 5.4pt' colspan='3'>" & Me!Anmeldeschluss & "</td></tr>"

'Signatur
signatur = "<table style='text-align: left; width:600px' cellpadding='3'>Mit freundlichen Grüßen Veranstaltungsmanagement der Mustermann AG" & _
"Mustermann AG " & _
"</table>"

'interne oder öffentliche Verteiler
If Me!flag_extern = True Then
intern = ""
interessenten = "andere Interessenten"
Else
intern = "AND NL_tbl_pers_nl.flag_extern=false"
interessenten = "andere Interessenten aus dem Konzern"
End If

mt10a = "Gerne können Sie diese Einladung auch an " & interessenten & " weiterleiten. </td></tr><tr><td style='width:600px' colspan='4'>" & _
kattext & "</td></tr> " & _
"<tr><td style='width:600px' colspan='4'>Weitere Veranstaltungen der Mustermann AG finden Sie auf unserer Homepage: </td></tr>" & _
"<tr><td style='width:180px;background:#cdcdcd;mso-background-themecolor:background1;mso-background-themeshade:217;border:none;padding:2pt 5.4pt 2pt 5.4pt' valign='top' colspan='1'>im Intranet:</td>" & _
"<td style='width:200px;background:#e5e5e5;mso-background-themecolor:background1;mso-background-themeshade:242;border:none;padding:2pt 5.4pt 2pt 5.4pt' colspan='1'><a *****'http://Mustermann AG.vw.vwg' title='Mustermann AG-Intranet'>Mustermann AG.vw.vwg</a></td>" & _
"<td style='width:220px;background:#e5e5e5;mso-background-themecolor:background1;mso-background-themeshade:242;border:none;padding:2pt 5.4pt 2pt 5.4pt' colspan='2'> (alle Veranstaltungen)</td></tr>" & _
"<tr style='width:600px'><td style='width:180px;background:#cdcdcd;mso-background-themecolor:background1;mso-background-themeshade:217;border:none;padding:2pt 5.4pt 2pt 5.4pt' valign='top' colspan='1'>im Internet:</td>" & _
"<td style='width:200px;background:#e5e5e5;mso-background-themecolor:background1;mso-background-themeshade:242;border:none;padding:2pt 5.4pt 2pt 5.4pt' colspan='1'><a *****'http://www.Mustermann AG.de' title='Mustermann AG-Internet'>http://termine.Mustermann AG.vw.vwg/" & Me!id_veranst & "_" & dat1!B_ID & ".ics'><img src='http://termine.Mustermann AG.vw.vwg/terminIcon.jpg' border='0' align='top'></a> " & VBA.Format(dat1!Datum, "ddd, dd.mm.yyyy") & "</td><td style='width:130px;background:#e5e5e5;mso-background-themecolor:background1;mso-background-themeshade:242;border:none;padding:2pt 5.4pt 2pt 5.4pt' colspan='1'>" & VBA.Format(dat1!von, "hh:nn") & " - " & VBA.Format(dat1!bis, "hh:nn") & " Uhr</td><td style='width:340px;background:#e5e5e5;mso-background-themecolor:background1;mso-background-themeshade:242;border:none;padding:2pt 5.4pt 2pt 5.4pt' colspan='2'>" & Ort & "</td></tr>"
End If

'Ergänzung Betreff wenn mehrere Tage
Select Case k1
Case 1
betreff = betreff & " am " & VBA.Format(dat1!Datum, "ddd, dd.mm.yyyy")

Case 2
If k2 = 0 Then
betreff = betreff & " am " & VBA.Format(dat1!Datum, "ddd, dd.mm.")
k2 = 1
Else
If Me!videokonf = True And k2 >= 1 Then
betreff = betreff
Else
betreff = betreff & " und " & VBA.Format(dat1!Datum, "ddd, dd.mm.yyyy")
End If
End If

Case 3
If Me!videokonf = True And k2 >= 1 Then
betreff = betreff
Else
Select Case k2
Case 0
betreff = betreff & " am " & VBA.Format(dat1!Datum, "ddd, dd.mm.")
k2 = 1
Case 1
betreff = betreff & ", " & VBA.Format(dat1!Datum, "ddd, dd.mm.")
k2 = 2
Case 2
betreff = betreff & " und " & VBA.Format(dat1!Datum, "ddd, dd.mm.yyyy")
End Select
End If

Case Is > 3
If Me!videokonf = True And k2 >= 1 Then
betreff = betreff
Else
If k2 = 0 Then
If Me!videokonf = True Then
betreff = betreff & " am " & VBA.Format(dat1!Datum, "ddd, dd.mm.yyyy")
k2 = 1
Else
betreff = betreff & " ab " & VBA.Format(dat1!Datum, "ddd, dd.mm.yyyy")
k2 = 1
End If
End If
End If
End Select

dat1.MoveNext
Loop

'Termindownload Erklärung
If dat!flag_extern = True Then
mt6 = ""
Else
mt6 = "<tr><td style='width:600px; font-size:8pt;line-height:10pt;border:none' colspan='4'>Durch Anklicken der <img src='http://termine.Mustermann AG.vw.vwg/terminIcon.jpg' border='0' align='top'> - Schaltfläche können Sie " & txt_termin_akkusativ & " in Ihren Outlook-Kalender zur Erinnerung einstellen. Bitte beachten Sie, dass zusätzlich eine <a *****'" & Me!Link_in & "' title='Mustermann AG-Anmeldung'>Anmeldung</a> für die Veranstaltung erforderlich ist. Ebenso wird eine eventuelle <a *****'" & Me!Link_in & "' title='Mustermann AG-Absage'>Absage</a> bei der Mustermann AG nicht durch das Löschen " & txt_termin_genitiv & " in Ihrem Outlook-Kalender ersetzt. </td></tr>"
End If

'Links & Weiterleitung Newsletter an andere Interessenten & weiteres Angebot Mustermann AG
If dat!flag_extern = True Then
mt10 = "<tr><td style='width:600px' colspan='4'>Weitere Informationen finden Sie im beigefügten Flyer. Bitte melden Sie sich über unsere <a *****'" & Me!link_ex & "' title='Mustermann AG-Anmeldung'>Homepage</a> an. "
'externer Anmeldelink
mt12 = "https://www.Mustermann AG.de/Mustermann AG_publish/www/de/newsletter.html"
logo = "<a *****'http://www.Mustermann AG.de' title='Mustermann AG - Homepage'><img src='http://www.Mustermann AG.de/Mustermann AG_publish/master.Logo.gif' border='0'></a>"

'Teilnehmergebühr extern
If Me!Teilnahmegebühr_extern > 0 Then
mt9 = "<tr><td style='width:130px;background:#cdcdcd;mso-background-themecolor:background1;mso-background-themeshade:217;border:none;padding:2pt 5.4pt 2pt 5.4pt' valign='top' colspan='1'>Teilnahmegebühr:</td><td style='width:470px;background:#e5e5e5;mso-background-themecolor:background1;mso-background-themeshade:242;border:none;padding:2pt 5.4pt 2pt 5.4pt' colspan='3'>€" & VBA.Format(Me!Teilnahmegebühr_extern, " ##,##0.-") & " " & Me!Teilnahmegebühr_freitext & "</td></tr>"
Else
mt9 = "<tr><td style='width:130px;background:#cdcdcd;mso-background-themecolor:background1;mso-background-themeshade:217;border:none;padding:2pt 5.4pt 2pt 5.4pt' valign='top' colspan='1'>Teilnahmegebühr:</td><td style='width:470px;background:#e5e5e5;mso-background-themecolor:background1;mso-background-themeshade:242;border:none;padding:2pt 5.4pt 2pt 5.4pt' colspan='3'>kostenfrei</td></tr>"
End If
Else
mt10 = "<tr><td style='width:600px' colspan='4'>Weitere Informationen finden Sie im beigefügten Flyer. Bitte melden Sie sich über unsere <a *****'" & Me!Link_in & "' title='Mustermann AG-Anmeldung'>Homepage</a> an. "
mt12 = "http://Mustermann AG.vw.vwg/Mustermann AG_publish/www/de/newsletter.html"
logo = "<a *****'http://Mustermann AG.de' title='Mustermann AG - Homepage'><img src='http://Mustermann AG.de/Mustermann AG_publish/Logo.gif' border='0'></a>"

'Teilnehmergebühr intern
If Me!Teilnahmegebühr > 0 Then
mt9 = "<tr><td style='width:130px;background:#cdcdcd;mso-background-themecolor:background1;mso-background-themeshade:217;border:none;padding:2pt 5.4pt 2pt 5.4pt' valign='top' colspan='1'>Teilnahmegebühr:</td><td style='width:470px;background:#e5e5e5;mso-background-themecolor:background1;mso-background-themeshade:242;border:none;padding:2pt 5.4pt 2pt 5.4pt' colspan='3'>€" & VBA.Format(Me!Teilnahmegebühr, " ##,##0.-") & " " & Me!Teilnahmegebühr_freitext & "</td></tr>"
Else
mt9 = "<tr><td style='width:130px;background:#cdcdcd;mso-background-themecolor:background1;mso-background-themeshade:217;border:none;padding:2pt 5.4pt 2pt 5.4pt' valign='top' colspan='1'>Teilnahmegebühr:</td><td style='width:470px;background:#e5e5e5;mso-background-themecolor:background1;mso-background-themeshade:242;border:none;padding:2pt 5.4pt 2pt 5.4pt' colspan='3'>kostenfrei</td></tr>"
End If
End If

'#####Newslettereinstellungen BEGINN#####
'Themen
tf = "<ul>"
If dat!pr = True Then tf = tf & "<li>Thema 1</li>"
If dat!pf = True Then tf = tf & "<li>Thema 2</li>"
If dat!sc = True Then tf = tf & "<li>Thema 3</li>"
If dat!mv = True Then tf = tf & "<li>Thema 4</li>"
If dat!in = True Then tf = tf & "<li>Thema 5</li>"
If dat!po = True Then tf = tf & "<li>Thema 6</li>"
If dat!fc = True Then tf = tf & "<li>Thema 7</li>"
If dat!un = True Then tf = tf & "<li>Thema 8</li>"
tf = tf & "</ul>"

If dat!nl_monat = True Then
mt11 = "<table><tr cellpadding='3'><td style='width:600px;background:#cdcdcd;mso-background-themecolor:background1;mso-background-themeshade:217;border:none;padding:2pt 5.4pt 2pt 5.4pt' >Ihre Newslettereinstellungen</td></tr>" & _
"<tr cellpadding='3'><td style='width:600px;background:#e5e5e5;mso-background-themecolor:background1;mso-background-themeshade:242;border:none;padding:2pt 5.4pt 2pt 5.4pt' >Sie haben sich für den monatlichen Newsletter und für Einzeleinladungen "
Else
mt11 = "<table><tr cellpadding='3'><td style='width:600px;background:#cdcdcd;mso-background-themecolor:background1;mso-background-themeshade:217;border:none;padding:2pt 5.4pt 2pt 5.4pt' >Ihre Newslettereinstellungen</td></tr>" & _
"<tr cellpadding='3'><td style='width:600px;background:#e5e5e5;mso-background-themecolor:background1;mso-background-themeshade:242;border:none;padding:2pt 5.4pt 2pt 5.4pt' ><Sie haben sich für Einzeleinladungen "
End If
mt11 = mt11 & "zu Veranstaltungen folgender Themen der Mustermann AG angemeldet:" & tf & " " & _
"Bitte klicken Sie auf die Links, um Ihre Newslettereinstellungen zu <a *****'" & dat!link_update & "' title = 'Änderung Newsletter Mustermann AG'>ändern</a> oder den Newsletter <a *****'" & dat!link_delete & "' title = 'Abmeldung Newsletter Mustermann AG'>abzubestellen</a>. " & _
"Sollten Sie diese Mail weitergeleitet bekommen haben, können Sie sich unter <a *****'" & mt12 & "' title = 'Anmeldung Newsletter Mustermann AG'>diesem Link</a> für den Newsletter der Mustermann AG anmelden. " & _
" Bei Fragen oder Problemen bezüglich des Newsletters stehen wir Ihnen gerne unter folgender Nummer zur Verfügung: . Der Newsletter wurde für die Darstellung in Outlook 2010 optimiert.</td></tr></table>"
'#####Newslettereinstellungen ENDE#####

'Hier wird alles zusammengesetzt
mailtext = "<div style='text-align:left; margin: 0 auto; width: 600pt'><center>" & mt0 & "<table><tr><td style='width:600px'>" & logo & "</td></tr></table><table><tr><td style='width:600px'>" & mt0 & mt1 & mt2 & mt3 & mt4 & mt5 & mt6 & mt7 & mt8 & mt9 & mt10 & mt10a & signatur & mt11 & "</table></center></div>"

'Anhang festlegen
If dat!flag_extern = True Then
att = Me!pdf_pfad_ex
Else
att = Me!pdf_pfad
End If

Set myolApp = CreateObject("Outlook.Application")
Set myitem = myolApp.CreateItem(0)
myitem.SentOnBehalfOfName = "newsletter@Mustermann AG.de"
myitem.Recipients.Add mailadresse
myitem.Subject = betreff
'myitem.BodyFormat = olFormatHTML
myitem.HTMLBody = mailtext
If Len(Trim(Nz([att]))) <> 0 Then
If att <> "(Keine Datei ausgewählt)" Then
Set objOutlookAttach = myitem.Attachments.Add(att)
End If
End If
myitem.Send

'Kennzeichnung von dat!aktuell_mail (User hat aktuelle Mail bekommen)
dat.Edit
dat!aktuell_mail = True
dat.Update
dat.MoveNext
Loop
'##############Spezieller Teil für jeden einzelnen User ENDE ##############

'Versanddatum und Anzahl Empfänger setzen
Me!newsl_versendet = True
newsl_versend_datum = Date
newsl_anzahl_empf = i

'Bei allen Datensätzen von dat das Feld dat!aktuell_mail auf false setzen
Set dat0 = CurrentDBC.OpenRecordset("NL_tbl_pers_nl")
Do Until dat0.EOF
dat0.Edit
dat0!aktuell_mail = False
dat0.Update
dat0.MoveNext
Loop
dat0.close
Set dat0 = Nothing

'Meldung nach Versand, mit Anzahl versendeter Newsletter
MsgBox "An " & i & " Empfänger wurde der Newsletter versandt!", vbInformation, "Newsletter versandt"

End Sub
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

Von der Versendezeit (mittlerweile 100 Mails in 30 Sekunden) bin ich jetzt nach den Anpassungen durch die Tipps hier eigentlich ganz zufrieden.

Atrus2711 · 14. November 2011

Hi,

dein Code wirft die Webseite im Browser durcheinander.

Aber ich ersehe eine zentrale Aussage ganz am Ende: "ganz zufrieden". Na dann: lass es so! *grins

Was heißt Plan wurde angefordert? Wo denn...
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

http://www.ms-office-forum.de/forum/...0&postcount=28

mille81 · 14. November 2011

Ja seh ich auch gerade... was meinste wie in Outlook aussieht wenn man richtiges HTMl verwendet ;-)

Ja okay. Testdaten is so ne Sache die Datenbank ist mittlerweile so groß und verknüpft....

Marsu65 · 14. November 2011

Großes OT:
Ist das beabsichtigt, dass
- jeder deinen Namen
- deinen Arbeitsplatz
- deine Telefonnummer
- den Namen deines Chefs ...
kennen soll?
Wenn nicht, würde ich evtl. die persönlichen Daten (i.e. Telefonnummern) löschen!

BTW: fehlen da vlt. ein paar Code-/HTML-Tags?

Arne Dieckmann · 14. November 2011

OT: Den HTML-Code habe ich nun entschärft, das Layout des Threads sollte somit wieder okay sein.

User · 14. November 2011

\@mille81

Hallo Christian,

ich weiß inzwischen auch wie Du heißt, wo Du arbeitest und mit wem Du deine Zeit verbringst *wink.gif*

von Marsu65

Wenn nicht, würde ich evtl. die persönlichen Daten (i.e. Telefonnummern) löschen!
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

Wenn es nicht noch mehr wissen sollen, würde ich den ganzen Code killen und hoffen dass das "Supergedächtnis" nicht schon drüber gerauscht ist! *Smilie
Oder zumindest die Telefonnummer aus der Var mt entfernen!

Gruß

LL

mille81 · 14. November 2011

Ups.... habs auch grad nochmal entschärft.

@Louisleon: Ich werds überleben ;-)
@arne Dieckmann: thx

Code und Tags fehlen jetzt höchstens nachm Edit von Arne.

User · 14. November 2011

Louisleon: Ich werds überleben ;-)
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

Das wollen wir doch hoffen, ich verrats auch keinem! *Smilie

Gruß

LL

Marsu65 · 14. November 2011

Fettes OT

..., ich verrats auch keinem!
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

Mal sehen, was die Chinesen so bieten. *wink.gif*

Ich muss mich immer wieder wundern, wie im Netz mit pers. Daten umgegangen wird.

Office: (Office 2010) Wie Performance verbessern?

Wie Performance verbessern?

Wie Performance verbessern?

Wie Performance verbessern?

Wie Performance verbessern?

Wie Performance verbessern? - Similar Threads - Performance verbessern

Performance bei Ausführung Tabellenerstellungsabfrage

Schnellere Lösung als Index Vergleich gesucht um aus Zeileninfos Matrix zu bilden

Performance Probleme beim Makro

KPIs (Key Performance Indicators) in Power Pivot

For Schleife, schlechte Performance

Performance verbessern

einen BIS-Wert aus Tabelle auslesen