|
Hallo f,
ich habe Dir mal Deinen Code fehlerfrei gemacht, da fehlte z.B. ein End If. Da hattest Du ein Else hingemacht.
Leider kann ich das Ganze in Ermangelung einer Beispieldatei nicht testen, also schau mal, ob es läuft.
Auch habe ich Deinen Code nicht vollständig optimiert, es ist ja Dein code. Hier noch ein paar Tipps.
Option Explicit einsetzen, das zwingt zur Variablendeklaration und vermeidet Fehler
OutlookApp nicht innerhalb einer Schleife immer wieder neu setzen...
Häufig verwendete Worksheet-Anweisungen z.B. durch Variable ersetzen, hier WSh...
Code einrücken, kann man besser lesen...
HTML-Text optimieren
Tags wie span und font haben auch ein Ende-Tag, welche für eine saubere Programmierung verwendet werden sollte.
vbCRLF sind bei HTML wirkungslos, bzw. nur zum Lesen des Codes. M.E. überflüssig.
Ggf. das ganze in einen body-Tag setzen, bei span gibt es für bestimmte Schriftgrößen manchmal Probleme.
Den font-Tag kannst Du Dir sparen, Du hast die Schriftgröße ja schon im span-Tag angegeben.
Code:
01
02
03
04
05
06
07
08
09
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79 |
|
Option Explicit
Sub Versand()
Dim Begrenzung As Integer
Dim i As Long
Dim r As Long
Dim numStart As Integer
' For i = 3 To Begrenzung
' If Worksheets("Hilfsblatt").Cells(i + 36, 2) = Wahr Then
' Exit For
Dim objOutlook As Object
Dim WSh As Worksheet
Dim Text As String
Dim Betreff As String
Dim Signature As String
Dim Bauvorhaben As String ' Name Bauvorhaben'
Dim Straße As String ' Straße Bauvorhaben'
Dim Ort As String ' Postleitzahl + Ort'
Dim Gewerk As String ' Gewerk''Eventuell hier auswahlbox einbauen'
Dim Bestellnummer As String ' BS-Nummer'
Dim Projeknummer As Long ' Projektnummer'
Dim sAntwortLink As String
sAntwortLink = "<a href='christine.oelinger@bavaria-massivhaus.de'>christine.oelinger@bavaria-massivhaus.de</a>"
Signature = Environ("appdata") & "\Microsoft\Signatures\Haas-Fertigbau-BM01.htm" ' °°°
Signature = CreateObject("Scripting.FileSystemObject").GetFile(Signature).OpenAsTextStream(-2).ReadAll
' Müssen noch angepasst werden'
Bauvorhaben = Worksheets("Tabelle1").Cells(37, 2) ' geändert 37=36+i
Set WSh = Worksheets("Hilfsblatt")
Straße = WSh.Cells(2, 37)
Ort = WSh.Cells(3, 37)
Gewerk = WSh.Cells(4, 37)
' Email
Text = "<span style='font-size:16pt; font-family:Arial'><b>" & "Bv" & Bauvorhaben _
& ", " & Straße & ", " & Ort & "</b><br>" _
& "<b>Einforderung des Bauvertrages" & "</b><br><br></span>" _
& "<span style='font-size:10pt; font-family:Arial'>" _
& "Sehr geehrte Damen und Herren,<br><br>" _
& "aktuell steht noch der unterschriebene Bauvertrag von Ihnen aus.<br><br>" _
& "Bitte senden Sie uns für das oben genannte Bauvorhaben den unterschriebenen Bauvertrag innerhalb der nächsten 2 Wochen zu.<br>" _
& "<br><br>" _
& "Bitte senden Sie die Unterlagen an: " & sAntwortLink & "<br><br></span>"
Betreff = "Einforderung Bauvertrag" & " " & "BV:" & " " & Bauvorhaben & " " & "in" & " " & Ort
Begrenzung = WSh.Cells(2, 2) + 1
Set objOutlook = CreateObject("Outlook.Application")
' Anhänge
For i = 1 To Begrenzung Step 1
If WSh.Cells(2 + i, 1) <> "FALSCH" Then
With objOutlook.CreateItem(0)
.To = Worksheets("Tabelle1").Cells(i + 3, 22)
.Subject = Betreff
.htmlBody = Text & Signature
.display
End With
End If
Next i
Set objOutlook = Nothing
End Sub
|
_________
viele Grüße
Karl-Heinz
|