Macro d'envoi d'emails fonctionnant mais pas dans perso.xls
Macro d'envoi d'emails fonctionnant mais pas dans perso.xls - VB/VBA/VBS - Programmation
MarshPosté le 26-09-2008 à 14:22:02
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)
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>"
Marsh Posté le 26-09-2008 à 14:22:02
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