none
Missing end sub, but where ? RRS feed

  • Question

  • Hi,

    I'm creating a script that will, when a technician send a mail to a client, the affiliated commercial will be put in copy.

    My code looks like this : 

    ThisOutlookSession

    Private Sub Application_ItemSend(ByVal Item As Object, Cancel As Boolean)
     
    'By Oliv' 29/06/2007 pour Outlook 2003
    'Modifié par D. Schneider le 30/03/2015
        
        If Not Item.Class = olMail Then GoTo fin
     
        Dim prompt As String
     
        '########################correspondance CC selon destinataire##############################
     
     
        Dim recip As Outlook.Recipient
        Dim sDomain As String
        Dim arTemp As Variant
        
        Set recip = Item.Recipients(1)
        arTemp = Split(recip.Address, "@", , vbTextCompare)
        sDomain = arTemp(1)
        
        cci = Get_Cial(sDomain)
     
        '########################Option CC##############################
     
        prompt = "Ajouter le cc " & cci & " à " & Item.Subject & "?"
     
        If MsgBox(prompt, vbYesNo + vbQuestion, "Sample") = vbYes Then
     
            Set myRecipient = Item.Recipients.Add(cci)
     
            myRecipient.Type = olCC
     
            myRecipient.Resolve
     
            If myRecipient.Resolved = False Then
     
                MsgBox "L'adresse Email n'est pas correcte !", vbCritical, "Erreur"
     
                Cancel = True
            End If
     
        End If
     
        '#######################FIN#####################################
     
    fin:
    
    End Function

    Module1

    Public MyArray()
     
    Sub Test_Get_Cial()
    Call Alimente_Liste
        MsgBox Get_Cial("exemple1.fr")
    End Sub
     
    Sub Alimente_Liste()
        Dim intFic As Integer
        Dim strLigne As String
        intFic = FreeFile
        Open "C:\Users\*****\Domaine-Cial.txt" For Input As intFic
        i = 0
        While Not EOF(intFic)
            Line Input #intFic, strLigne
            ReDim Preserve MyArray(i)
            MyArray(i) = strLigne
            i = i + 1
        Wend
        Close intFic
    End Sub
     
     
    Function Get_Cial(Email) As String
        Get_Cial = ""
        For i = 0 To UBound(MyArray)
            If Split(MyArray(i), ";", , vbTextCompare)(0) = Email Then
                Get_Cial = Split(MyArray(i), ";", , vbTextCompare)(1)
                Exit For
            End If
        Next i
    
    End Function
    

    But when I try to test it, I get and error saying there's a missing 'end sub' but I can't find where 

    Thursday, April 2, 2015 7:36 AM

Answers

  • Private Sub Application_ItemSend(ByVal Item As Object, Cancel As Boolean)

    '''  End Function  <<<

    End Sub

    Voila!

    Thursday, April 2, 2015 8:41 AM
    Moderator

All replies