Makro til at afsende mail med flere modtagere og forskellige resultater.
HejJeg har forsøgt at opsætte et regneark hvori jeg opsamler svar fra en analyse fra testpersoner. Svarene skal herefter uddeles på forskellige ark alt efter hvem deres leder er. Efterfølgende skal der sendes en mail til den respektive leder.
Det der driller mig er at jeg ikke kan få den til at indsætte navnet på testpersonen i mailen, og at den vedhæftede fil ikke er opdateret .
Jeg har brugt følgende makroer:
Til søgning efter testpersoner:
Function FLOPSLAG(ops As Variant, num As Single, rn As Range, ofs As Byte)
Dim Taeller As Long
Dim i As Long
i = 0
For Each C In rn.Columns(1).Cells
If C.Value = ops Then
i = i + 1
End If
Next C
If num - CInt(num) <> 0 Or num < 1 Then
FLOPSLAG = CVErr(xlErrNum)
Exit Function
End If
If i < num Then
FLOPSLAG = CVErr(xlErrNA)
Exit Function
End If
Taeller = 0
For Each C In rn.Columns(1).Cells
If C.Value = ops.Value Then
Taeller = Taeller + 1
If Taeller = num Then
FLOPSLAG = C.Offset(0, ofs - 1).Value
Exit Function
End If
End If
Next C
End Function
Til afsendelse af mail har jeg gjort brug af kode fra http://www.rondebruin.nl/sendmail.htm som skulle sende til forskellige modtagere ved ændring i et resultat.
Option Explicit
Private Sub Worksheet_Calculate()
Dim FormulaRange As Range
Dim NotSentMsg As String
Dim MyMsg As String
Dim SentMsg As String
Dim MyLimit As Double
NotSentMsg = "Not Sent"
SentMsg = "Sent"
'Above the MyLimit value it will run the macro
MyLimit = 10
'Set the range with Formulas that you want to check
Set FormulaRange = Me.Range("B3:B25")
On Error GoTo EndMacro:
For Each FormulaCell In FormulaRange.Cells
With FormulaCell
If IsNumeric(.Value) = False Then
MyMsg = "Not numeric"
Else
If .Value > MyLimit Then
MyMsg = SentMsg
If .Offset(0, 1).Value = NotSentMsg Then
Call Mail_with_outlook2
End If
Else
MyMsg = NotSentMsg
End If
End If
Application.EnableEvents = False
.Offset(0, 1).Value = MyMsg
Application.EnableEvents = True
End With
Next FormulaCell
ExitMacro:
Exit Sub
EndMacro:
Application.EnableEvents = True
MsgBox "Some Error occurred." _
& vbLf & Err.Number _
& vbLf & Err.Description
End Sub
og
Sub Mail_with_outlook2()
'For mail code examples visit my mail page at:
'http://www.rondebruin.nl/sendmail.htm
Dim OutApp As Object
Dim OutMail As Object
Dim strto As String, strcc As String, strbcc As String
Dim strsub As String, strbody As String
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
strto = ""
strcc = ""
strbcc = ""
strsub = "APV indtastninger"
strbody = "Hej. Så er der en ny APV indtastning for." & Cells(FormulaCell.Row, "A").Value & vbNewLine & vbNewLine & _
"Se vedhæftet fil."
With OutMail
.To = strto
.CC = strcc
.BCC = strbcc
.Subject = strsub
.Body = strbody
'You can add a file to the mail like this
'.Attachments.Add ("C:\Users\hta\Documents\Arbejde hjemme\originaler APV\TEST APV - samme side.xlsm")
.Display ' or use .send
End With
Set OutMail = Nothing
Set OutApp = Nothing
End Sub
Jeg har alle svar samlet på et ark(Svar), resultater fra de respektive testpersoner på hver deres ark("Navn") og opsamling på resultat til mail på et ark(Mail) Som ser ud som eksemplet fra http://www.rondebruin.nl/win/s1/outlook/bmail9.htm , men det ved jeg ikke om er smart?