Avatar billede Heltnyidether Novice
09. januar 2017 - 12:17

Makro til at afsende mail med flere modtagere og forskellige resultater.

Hej
Jeg 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?
Avatar billede Ny bruger Nybegynder

Din løsning...

Tilladte BB-code-tags: [b]fed[/b] [i]kursiv[/i] [u]understreget[/u] Web- og emailadresser omdannes automatisk til links. Der sættes "nofollow" på alle links.

Loading billede Opret Preview

Log ind eller opret profil

Hov!

For at kunne deltage på Computerworld Eksperten skal du være logget ind.

Det er heldigvis nemt at oprette en bruger: Det tager to minutter og du kan vælge at bruge enten e-mail, Facebook eller Google som login.

Du kan også logge ind via nedenstående tjenester