berechneter Wert per eM@il verschicken
18.08.2013 19:41:00
Atuatuca
ich bin noch ein blutiger anfänger und habe mir da mal ein makro zusammen gezimmert (aus verschiedenen codes aus dem www). Funktioniert alles auch soweit.
1. Problemchen
nur dass ich eigentlich in der spalte I ein berechnetes Datum und in Spalte H ein Wert aus einer anderen Tabelle übernommen wird, kann ich so aber nicht einbauen (z.Zt händisch eingegeben). Kann man das Ergebnis (das was ich in der Tabelle sehe) irgendwie in einer Email reinbekommen.
2. Problemchen
ich würde gerne nur eine Email erhalten, falls mehrere Datensätze zutreffen auf die angegeben Bedingungen. Leider bekomme ich das nicht hin, z. Zt erhalte ich eine Email pro Datensatz.
Vielleicht hat einer von euch eine Idee(n).
Hier der Code:
Sub Mail_Body_Bomar_Moon()
Dim iMsg As Object
Dim iConf As Object
Dim cell As Range
Dim Flds As Variant
Dim strbody As String
Dim i As Integer
Dim AnzahlZeilen As Integer
AnzahlZeilen = Range("A65536").End(xlUp).Row
For i = 2 To AnzahlZeilen
strbody = "Good day dear ladies and gentlemen," & vbNewLine & vbNewLine & _
"Please note that we did not receive from Mv " + cells(i, 1) + " below LubOil- _
sample(s)" & vbNewLine & _
"or it has not been registed yet. The office will double check with" & vbNewLine _
_
_
_
_
_
_
& _
"the laboratory. Please double check from your end if the below" & vbNewLine & _
"LubOil-sample has been taken and send to the laboratory." & vbNewLine & _
vbNewLine & _
"Ship: Mv " + cells(i, 1) & vbNewLine & _
"Equipment: " + cells(i, 5) & vbNewLine & _
"Component: " + cells(i, 6) & vbNewLine & _
"Due date: " & Format(cells(i, 9), "DD.MM.YY") & vbNewLine & vbNewLine & _
"Last sample from: " & Format(cells(i, 7), "DD.MM.YY") & vbNewLine & _
"Sample ID: " + cells(i, 2) & vbNewLine & _
"Interval: " & Format(cells(i, 8), "##,##0.0") + " Months" & vbNewLine & _
vbNewLine & _
"If Sample has been taken and handed over to agent, please revert with" & _
vbNewLine & _
"the corresponding landingreport, if not done so far. We will also get" & _
vbNewLine & _
"in contact with the agent in the port of landing of the LubOil-sample(s)" & _
vbNewLine & vbNewLine & vbNewLine & _
"Mit freundlichen Gruessen / with best regards" & vbNewLine & vbNewLine & _
"Das Kontrolteam von Excel"
Next i
With Application
.ScreenUpdating = False
.EnableEvents = False
End With
Set iConf = CreateObject("CDO.Configuration")
iConf.Load -1 ' CDO Source Defaults
Set Flds = iConf.Fields
With Flds
.Item("http://schemas.microsoft.com/cdo/configuration/smtpusessl") = True
.Item("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = 1
.Item("http://schemas.microsoft.com/cdo/configuration/sendusername") = "me@myprovider.de"
.Item("http://schemas.microsoft.com/cdo/configuration/sendpassword") = "habe_keins"
.Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "mail.myprovider.de"
.Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
.Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25
.Update
For Each cell In Sheets("BOMAR MOON - LO").Columns("I").cells.SpecialCells( _
xlCellTypeConstants)
If cell.Value "
.Subject = "Mv Bomar Moon - LubOil-Sample(s) missing"
.TextBody = strbody
.Send
End With
Set iMsg = Nothing
End If
Next cell
For Each cell In Sheets("BOMAR MOON - LO").Columns("I").cells.SpecialCells( _
xlCellTypeConstants)
If cell.Value