VBA envoie mail

Question

Bonjour, J'ai fait une macro qui permet d'envoyer ce type de mail : Ci-dessous un resume des references en retard (shipment < 1 mois). Pour chaques references citées, il manque des elements qualités : OK production non donné. Merci d'en prendre note et d'appuyer notre relance. Pour plus de details sur les éléments manquants cliquez sur ce lien :File://...\ETE%2008%20-%20Homme%20Femme\suivi-été2008-Homme.xls FOURNISSEUR / REFERENCE / QUANTITE COMMANDEE / INSPECTION ? / CONTACT A PEC01 6204 Veritas BD X A AMERICAN 168 Veritas BD R X B AB002 1892 Y B AB001 1892 Y J'ai une base de donnée excel. Lorsque j'execute ma macro, je ne peux pas prendre en compte plus de 147 lignes or mon tableau en compte 600/700 Voici le marco : Sub infopouracheteursF() Dim nb As Integer Dim tableausuivi2() nb = CInt(InputBox("nbre de lignes ?")) + 1 dimtableau = nb - 4 counter = 0 ReDim Preserve tableausuivi2(0 To (nb - 4), 5) For i = 7 To nb resultat = False For k = 0 To UBound(tableausuivi2) If fittaille(ActiveSheet.Cells(i, 3)) = tableausuivi2(k, 1) Then If fittaille(ActiveSheet.Cells(i, 1)) = tableausuivi2(k, 0) Then resultat = True dimtableau = dimtableau - 1 counter = counter + 1 Exit For Else resultat = False End If Else resultat = False End If Next k If ActiveSheet.Cells(i, 9) "RECEIVED" And ActiveSheet.Cells(i, 10) "RECEIVED" Then resultat = True dimtableau = dimtableau - 1 counter = counter + 1 End If If ActiveSheet.Cells(i, 11) > 30 Then resultat = True dimtableau = dimtableau - 1 counter = counter + 1 End If If resultat = False Then tableausuivi2(i - 7 - counter, 0) = fittaille(ActiveSheet.Cells(i, 1)) tableausuivi2(i - 7 - counter, 1) = fittaille(ActiveSheet.Cells(i, 3)) tableausuivi2(i - 7 - counter, 2) = fittaille(ActiveSheet.Cells(i, 5)) tableausuivi2(i - 7 - counter, 3) = fittaille(ActiveSheet.Cells(i, 6)) tableausuivi2(i - 7 - counter, 4) = fittaille(ActiveSheet.Cells(i, 14)) tableausuivi2(i - 7 - counter, 5) = ActiveSheet.Cells(i, 15) End If Next tableausuivi = tableausuivi2 Set appword = CreateObject("Word.Application") WordBasic.sortarray tableausuivi Dim osession As MAPI.Session Dim omessage As message Dim oRecip As Recipient Set osession = CreateObject("MAPI.Session") osession.Logon Dim message As String message = "Ci-dessous un resume des references en retard (shipment < 1 mois)." & vbCrLf & "Pour chaques references citées, il manque des elements qualités : OK production non donné." & vbCrLf & "Merci d'en prendre note et d'appuyer notre relance." & vbCrLf & "Pour plus de details sur les éléments manquants cliquez sur ce lien :" & "File://G:\__COMMUN_EMC\Qualité\suivi%20inspections%20textile\HOMME%20-%20FEMME\ETE%2008%20-%20Homme%20Femme\suivi-été2008-Femme.xls" & vbCrLf & vbCrLf & vbCrLf & " FOURNISSEUR" & " " & " REFERENCE" & " " & " QUANTITE COMMANDEE " & " " & " INSPECTION ?" & " " & " CONTACT" & vbCrLf Dim MailAd As String Dim Msg As String Dim Subj As String Dim URLto As String For i = 0 To dimtableau + 1 Count = 0 k = i + 1 If k > dimtableau + 1 Then Exit For Do Until k = dimtableau + 1 If tableausuivi(k, 0) = tableausuivi(i, 0) Then message = message & vbCrLf & tableausuivi(k, 0) & " " & tableausuivi(k, 1) & " " & tableausuivi(k, 2) & " " & tableausuivi(k, 3) & " " & tableausuivi(k, 4) & "" Count = Count + 1 End If k = k + 1 Loop message = message & vbCrLf & tableausuivi(i, 0) & " " & tableausuivi(i, 1) & " " & tableausuivi(i, 2) & " " & tableausuivi(i, 3) & " " & tableausuivi(i, 4) & "" i = i + Count Next MailAd = "zzfemme" Set omessage = osession.Outbox.Messages.Add omessage.Subject = "E08 - Ref en retard avec shipment < 1 Mois" Set oRecip = omessage.Recipients.Add(MailAd) oRecip.Resolve omessage.Text = message omessage.Send True osession.Logoff End Sub Public Function fittaille(ByRef reference2 As String) As String Reference = Trim(reference2) If Len(Reference) < 12 Then For i = 1 To 12 - Len(Reference) Reference = Reference & " " Next Else Reference = Left(Reference, 12) End If fittaille = CStr(Reference) End Function Donc lorsque je l'execute, je ne peux mettre plus de 147 lignes à nb = CInt(InputBox("nbre de lignes ?")) + 1. Si je demande par exemple 148 lignes il me fait un debogage sur cette ligne: tableausuivi2(i - 7 - counter, 0) = fittaille(ActiveSheet.Cells(i, 1)) Dans l'attente de votre aide, merci. Merci de m'indiquer comment faire pour pouvoir mettre 600 lignes ds le nb ;)

cs_DARKSIDIOUS · Answer

Salut,

Si tu fais du VBA, pourquoi tu poste dans le forum VB.NET ?????

Je déplace vers le forum approprié !
______________________________________
DarK Sidious

cs_MPi · Answer

Quel est le message d'erreur ?

Je pense, mais pas certain, que c'est dû à ton type de paramètre
Public Function fittaille(ByRef reference2 As String) As String 

Quand tu l'appelles
If fittaille(ActiveSheet.Cells(i, 3)) = tableausuivi2(k, 1) Then 
tu lui passes la cellule, donc un Range et non pas son texte ou sa valeur

Lors du message d'erreur, clique le bouton Débogage et tape F8 jusqu'à ce que tu trouves la ligne en défaut. Ce n'est pas nécessairement cette ligne.

MPi²

kikou6969 · Answer

Donc quand je fais debogage + F8, l'erreur s'arrete sur le end de la fonction   Public Function fittaille(ByRef reference2 As String) As String 

Tu m'a parlé d'une ligne non necessaire, merci de m'indiquer laquelle ;).

cs_MPi · Answer

Sur le End ?
Si tu refais encore F8, c'est sur le End Function que tu reçois le message d'erreur ?
Si oui, je n'y comprends rien ou alors il y a une erreur de frappe, syntaxe...

PS: je n'ai parlé d'aucune ligne superflue (?)

MPi²

VBA envoie mail

4 réponses

Votre réponse

Discussions similaires