Emailing Random PIN numbers

[bowlesstan]

Hi this is my first post, I'm sorry if this has been asked before. Ok here goes.

Every evening at Approx 23:00 We send an email to our security depts with a daily pin, this is a random 4 digit code which which will be used code in our door access. We make up the numbers on a daily basis and Email these to three different internal departments. How would I go about getting excel to do this via a macr or something similar. Or am I just whistling in the wind.
Any help would be appreciated

 

[bowlesstan]

Like i said that worked like a treat thanks for that. But what i would like to do next is put in a MsgBox which will inform the user that if they click on Daily Pin this will automatically send out three mails something like "Are you sure you no what your doing!!!" , if they clicked on it by mistake they then have the option to not send the PINS. Can this be done in the same script? Any help or advice would be appreciated.

 

[mrmmickle1]

Add these lines:

Private Sub send_pin()


    Dim OutApp As Object
    Dim OutMail As Object
    Dim strbody As String
    Dim arrTo As Variant
    Dim arrSubject As Variant
    Dim intLp As Integer
[COLOR=#ff0000]    Dim Ans As String[/COLOR]
    
    arrTo = Array("me1@email.com", "me2@email.com", "me3@email.com")
    arrSubject = Array("PIN# 1", "PIN# 2", "PIN# 3")
    
[COLOR=#ff0000]    Ans = MsgBox("Are you sure you want to send 3 emails?", vbQuestion + vbYesNo, "Final Chance to stop....")[/COLOR]
[COLOR=#ff0000]    If Ans = vbYes Then[/COLOR]


        For intLp = 0 To 2
            Set OutApp = CreateObject("Outlook.Application")
            Set OutMail = OutApp.CreateItem(0)
            
            strbody = CInt(((9999 - 1000) * Rnd) + 1000)
            
            On Error Resume Next
            
            With OutMail
                
                .To = arrTo(intLp)
                .Subject = arrSubject(intLp)
                .Body = strbody
            
            .Send
            
            End With
            
            On Error GoTo 0
            
            Set OutMail = Nothing
            Set OutApp = Nothing
        Next intLp
        
[COLOR=#ff0000]    End If[/COLOR]


End Sub