Forum |  HardWare.fr | News | Articles | PC | S'identifier | S'inscrire | Shop Recherche
2759 connectés 

  FORUM HardWare.fr
  Programmation
  VB/VBA/VBS

  Macro d'envoi d'emails fonctionnant mais pas dans perso.xls

 


 Mot :   Pseudo :  
 
Bas de page
Auteur Sujet :

Macro d'envoi d'emails fonctionnant mais pas dans perso.xls

n°1792432
Pofito
Posté le 26-09-2008 à 14:22:02  profilanswer
 

Bonjour,
 
Voici le problème que je rencontre actuellement : j'ai créé une macro qui permet d'envoyer des mails via outlook. Cette macro, je l'ai créé dans un classeur, j'ai bien activé les références de librairies, et tout marche parfaitement.
Cependant, j'ai voulu mettre ce module dans mon classeur de macros personnelles (perso.xls) pour qu'elle soit accessible de n'importe quel classeur et là je tombe sur l'erreur suivante "Type défini par l'utilisateur non défini" sur la ligne suivante :
 
Dim oEmail As Outlook.MailItem
 
Je ne comprends vraiment pas pourquoi ca fonctionne dans un module d'un classeur et pas dans mon classeur personnel, surtout que les références outlook sont bien activée (Microsoft Office 11.0 Object Librairy). J'ai aussi essayé de passer par un classeur de macros complémentaires mais j'obtiens toujours la même erreur...
 
Voici l'intégralité du code de ma macro... Merci d'avance pour votre aide !
 
 
Public Sub CreateEmail()
 
    Dim i As Integer
    Dim j As Integer
    Dim oEmail As Outlook.MailItem
    Dim appOutLook As Outlook.Application
    Dim x As String
    Dim y As String
    Dim z As String
    Dim name As String
    Dim MaLigne As String
    Dim Part1 As String
    Dim Part2 As String
    Dim Part3 As String
     
    ' créer un nouvel item mail
 
    Set appOutLook = New Outlook.Application
    Set oEmail = appOutLook.CreateItem(olMailItem)
     
         
    ' Cherche la plage du détail
     
    x = ActiveCell.Row
    name = ActiveSheet.name
 
MaLigne = Sheets(name & "_Source" ).Range("A65536" ).End(xlUp).Row - 3
 
For i = 1 To MaLigne
 
If Sheets(name & "_Source" ).Cells(i, 1).Value = Sheets(name).Cells(x, 1).Value And Sheets(name & "_Source" ).Cells(i, 2).Value = Sheets(name).Cells(x, 2).Value Then
y = i
i = MaLigne - 4
Else
End If
Next i
 
If Sheets(name & "_Source" ).Cells(y + 1, 1).Value = "" Then
z = y + 2
Else
z = Sheets(name & "_Source" ).Cells(y, 1).End(xlDown).Row + 2
End If
     
 
    'Première partie du message texte
     
    Part1 = "<FONT face=Arial size=2>" _
    & "Dear " & Sheets(name).Cells(x, 10).Value & " and " & Sheets(name).Cells(x, 11).Value & "," _
    & "<BR><BR><BR>" _
    & "In Pack 01 of " & Right(Sheets(name).Cells(7, 1), 3) & ", we have the following intercos mismatches (In Euro)." _
    & "<BR><BR>" _
    & "Please kindly reconcile with your counterparts and send me an agreed answer." _
    & "<BR><BR>" _
    & "Thank you." _
    & "<BR><BR><BR>" _
    & "<b><u>" & Sheets(name).Cells(3, 1).Value & "</u></b>" _
    & "<BR><BR>"
   
   
    'Deuxième partie du message texte
    Part2 = "<table><tr ALIGN=center><td width=90 style='border-bottom:1 solid black'><FONT face=Arial size=2>" & Sheets(name & "_Source" ).Range("A13" ).Value & "</FONT></td>" _
    & "<td width=90 style='border-bottom:1 solid black'><FONT face=Arial size=2>" & Sheets(name & "_Source" ).Range("B13" ).Value & "</FONT></td>" _
    & "<td width=90 style='border-bottom:1 solid black'><FONT face=Arial size=2>" & Sheets(name & "_Source" ).Range("C13" ).Value & "</FONT></td>" _
    & "<td width=90 style='border-bottom:1 solid black'><FONT face=Arial size=2>" & Sheets(name & "_Source" ).Range("D13" ).Value & "</FONT></td>" _
    & "<td width=90 style='border-bottom:1 solid black'><FONT face=Arial size=2>" & Sheets(name & "_Source" ).Range("E13" ).Value & "</FONT></td>" _
    & "<td width=90 style='border-bottom:1 solid black'><FONT face=Arial size=2>" & Sheets(name & "_Source" ).Range("F13" ).Value & "</FONT></td></tr>"
 
    For i = y To z - 1      'nombre de lignes (exemple plage A1:B5)
    Part2 = Part2 & "<tr ALIGN=center>"
    For j = 1 To 6      'nombre de colonnes
    Part2 = Part2 & "<TD><FONT face=Arial size=2>" _
    & Sheets(name & "_Source" ).Cells(i, j) & "</FONT></TD>"
    Next j
    Part2 = Part2 & "</TR>"
    Next i
    Part2 = Part2 & "<tr ALIGN=center>"
    For j = 1 To 6      'nombre de colonnes
    Part2 = Part2 & "<TD><FONT face=Arial size=2><b>" _
    & Sheets(name & "_Source" ).Cells(z, j) & "<b></FONT></TD>"
    Next j
    Part2 = Part2 & "</TR></TABLE>"
 
 
    'Troisième partie du message texte
     
    Part3 = "<BR><BR>" _
    & "Regards," _
    & "<BR><BR>"
 
 
    oEmail.BodyFormat = olFormatHTML
 
    oEmail.To = Sheets(name).Cells(x, 10).Value & ";" & Sheets(name).Cells(x, 11).Value
    oEmail.Subject = "Intercos " & Sheets(name).Cells(x, 1).Value & " - " & Sheets(name).Cells(x, 2).Value & "  " & ActiveSheet.name & " " & Right(Sheets(name).Cells(7, 1), 3)
    oEmail.HTMLBody = Part1 & Part2 & Part3
       
 
   'affichage du mail
    With oEmail
    .Display
    End With
     
    ' détruit les références aux objets
    Set oEmail = Nothing
 
    Set appOutLook = Nothing
 
End Sub

mood
Publicité
Posté le 26-09-2008 à 14:22:02  profilanswer
 

n°1792603
Idoine
Posté le 26-09-2008 à 17:01:40  profilanswer
 

Tu as bien fait référence à la bibliothèque Microsoft Office Outlook 11.0 Object Library dans le projet de Perso.xls ?


Message édité par Idoine le 26-09-2008 à 17:02:16

Aller à :
Ajouter une réponse
  FORUM HardWare.fr
  Programmation
  VB/VBA/VBS

  Macro d'envoi d'emails fonctionnant mais pas dans perso.xls

 

Sujets relatifs
File d'attente d'envoi outlook 2003Creer un PDF depuis Excel et envoi directement en pièce jointe d'un ma
[VBA] Macro exécutée pas à pas...Manipulation d'un nom de template dans une #define-macro
macro pour jeuxvideo aide!problemed'envoi et de reception à une fonction
Import Access fichier 'txt' à modifier via macro ...[VBA - Excel] Envoi d'un mail via un service gratuit
[VBA EXCEL 2007] macro ultra lenteMacro qui 'executent toutes seules??
Plus de sujets relatifs à : Macro d'envoi d'emails fonctionnant mais pas dans perso.xls


Copyright © 1997-2022 Hardware.fr SARL (Signaler un contenu illicite / Données personnelles) / Groupe LDLC / Shop HFR