Problème avec la fonction send de VBA

Le 08/11/2022 à 15:48

Bonjour,

Je désire créer un envoi d'alerte (par pdf) en automatique via outlook après une recherche dans un tableau excel.

Merci d'avance pour vos retour...

Voici le programme en (le pb rouge après l'émoji) :

Sub Peremption()
'
' Peremption Macro

' Dimonsionnement

Dim Kpt As Integer
Dim Ligmax As Integer
Dim Lig1 As Integer
Dim Lig2 As Integer
Dim Butee As Date
Dim Peremp As Date
Dim Produit As String

' initialisation paramétrage

Ligmax = Range("AA1").Value
Kpt = 5
Butee = Range("A1").Value
Lig1 = 5
Lig2 = 5

' Initialisation des Fles

' Fle1 Base de Données

Sheets("Feuil1").Select
Range("A1").Select

' Fle2 A venir

Sheets("Feuil2").Visible = True
Sheets("Feuil2").Select
ActiveWindow.ScrollColumn = 9
ActiveWindow.ScrollColumn = 8
ActiveWindow.ScrollColumn = 7
ActiveWindow.ScrollColumn = 6
ActiveWindow.ScrollColumn = 5
ActiveWindow.ScrollColumn = 4
ActiveWindow.ScrollColumn = 3
ActiveWindow.ScrollColumn = 2
ActiveWindow.ScrollColumn = 1
Rows("5:85").Select
Selection.ClearContents

' Fle3 A traiter

Sheets("Feuil3").Visible = True
Sheets("Feuil2").Select
ActiveWindow.ScrollColumn = 9
ActiveWindow.ScrollColumn = 8
ActiveWindow.ScrollColumn = 7
ActiveWindow.ScrollColumn = 6
ActiveWindow.ScrollColumn = 5
ActiveWindow.ScrollColumn = 4
ActiveWindow.ScrollColumn = 3
ActiveWindow.ScrollColumn = 2
ActiveWindow.ScrollColumn = 1
Rows("5:85").Select
Selection.ClearContents

' Recherche FLU 1

For Kpt = 5 To Ligmax + 1
Peremp = Cells(Kpt, 2)

If Peremp > Butee Then
If Peremp > Butee + 30 Then
' Ok
Else
' A venir

Produit = ActiveCell
Range(Cells(Kpt, 1), Cells(Kpt, 5)).Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Feuil2").Select
ActiveWindow.SmallScroll Down:=-81
Cells.Cells(Lig1, 1).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Sheets("Feuil1").Select
Range("A1").Select

' Incrément

Lig1 = Lig1 + 1

End If
Else
' A traiter

Produit = ActiveCell
Range(Cells(Kpt, 1), Cells(Kpt, 5)).Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Feuil3").Select
ActiveWindow.SmallScroll Down:=-81
Cells.Cells(Lig2, 1).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Sheets("Feuil1").Select
Range("A1").Select

' Incrément

Lig2 = Lig2 + 1

End If

' initialisation paramétrage

Sheets("Feuil1").Select
Next Kpt

Kpt = 105
Ligmax = Range("AA2").Value
Ligmax = Ligmax + 105
Lig1 = Lig1 + 1
Lig2 = Lig2 + 1

' Recherche 2

For Kpt = 105 To Ligmax + 1
Peremp = Cells(Kpt, 2)
If Peremp > Butee Then
If Peremp > Butee + 30 Then

Else
' A venir

Produit = ActiveCell
Range(Cells(Kpt, 1), Cells(Kpt, 5)).Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Feuil2").Select
ActiveWindow.SmallScroll Down:=-81
Cells.Cells(Lig1, 1).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Sheets("Feuil1").Select
Range("A1").Select

' Incrément

Lig1 = Lig1 + 1

End If
Else
' A traiter

Produit = ActiveCell
Range(Cells(Kpt, 1), Cells(Kpt, 5)).Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Feuil3").Select
ActiveWindow.SmallScroll Down:=-81
Cells.Cells(Lig2, 1).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Sheets("Feuil1").Select
Range("A1").Select

' Incrément

Lig2 = Lig2 + 1

End If

Sheets("Feuil1").Select
Next Kpt

' Création du PDF

Sheets("Feuil2").Select
ChDir "C:\Users\xxx\Desktop"
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
"C:\Users\xxx\Desktop\xxx.pdf", Quality:=xlQualityStandard, _
IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:= _
False

Sheets("Feuil3").Select
ChDir "C:\Users\j76571\Desktop"
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
"C:\Users\xxx\Desktop\xxx.pdf", Quality:=xlQualityStandard, _
IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:= _
False

' Fin

Sheets("Feuil2").Select
ActiveWindow.SelectedSheets.Visible = False
Sheets("Feuil3").Select
ActiveWindow.SelectedSheets.Visible = False

Dim oOutlook As Object

'utilisation d'Outlook pour l'envoie de l'email
On Error Resume Next
Set oOutlook = GetObject(, "Outlook.Application")
On Error GoTo 0

If oOutlook Is Nothing Then
Shell "Outlook.exe", vbHide
Set oOutlook = GetObject(, "Outlook.Application")
End If

Dim oMail As Object
Set oMail = oOutlook.CreateItem(0)

With oMail
Dim oObjetWord As Object
Set oObjetWord = .GetInspector.WordEditor
.To = "y.z@test.fr" 'destinataire
.Subject = "Sujet" & ThisWorkbook.Name 'Objet du mail
.Attachments.Add ("C:\Users\xxx\Desktop\xxx.pdf") 'chemin d'accès à la pièce jointe
.Attachments.Add ("C:\Users\xxx\Desktop\xxx.pdf") 'chemin d'accès à la pièce jointe
.Send
End With

Range("A1").Select

ChDir "C:\Users\xxx\Desktop"
ActiveWorkbook.SaveAs Filename:="C:\Users\xxx\Desktop\xxx_.xlsm", _
FileFormat:=xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False ' Sauvegarde du fichier

End Sub

Edit modo : code mis entre balises, attention la prochaine fois

Cordialement.

Le 09/11/2022 à 10:40

Bonjour,

Tout d'abord, pensez à utiliser la balise "</>" pour insérer du code.

Essayer le code ci-joint

    Dim oOutlook As Object, omail As Object, oObjetWord As Object

    'utilisation d'Outlook pour l'envoi de l'email
    On Error Resume Next
    Set oOutlook = GetObject(, "Outlook.Application")
    On Error GoTo 0
    If oOutlook Is Nothing Then Set oOutlook = CreateObject("Outlook.Application")
    If oOutlook.Explorers.Count = 0 Then
        oOutlook.Session.GetDefaultFolder(6).Display
        oOutlook.ActiveExplorer.WindowState = olMinimized
    End If

    Set omail = oOutlook.CreateItem(0)
    With omail
        Set oObjetWord = .GetInspector.WordEditor

        .To = "y.z@test.fr" 'destinataire
        .Subject = "Sujet" & ThisWorkbook.Name 'Objet du mail
        .Attachments.Add ("C:\Users\xxx\Desktop\xxx.pdf") 'chemin d'accès à la pièce jointe
        .Attachments.Add ("C:\Users\xxx\Desktop\xxx.pdf") 'chemin d'accès à la pièce jointe
        .Send

    End With
Le 09/11/2022 à 12:00

Bonjour,

Merci pour cette réponse rapide, mais le problème persiste. Le bug est toujours au même endroit...

J'ai bien la création d'un brouillon, mais pas l'envoi.

Cordialement.

Le 09/11/2022 à 13:22

bonjour,

un problème ? quel est le problème ? reçois-tu un message d'erreur ? lequel ?

Le 09/11/2022 à 14:53

Voici le message d'erreur au niveau du ".SEND" :

image
Le 09/11/2022 à 16:55

bonjour,

voyant ce message, quel est le problème selon toi ? Il me semble que le message d'erreur est clair, non ? les adresses mails ne sont pas correctes et/ou les noms des destinataires ne sont pas trouvés dans le répertoire Outlook.

Le 09/11/2022 à 17:42

si vous remplacez ".Send" avec ".display", ça fonctionne ?

Voyez-vous le mail ?

Le 10/11/2022 à 08:47

Bonjour,

Avec "display" avant "send" cela fonctionne.

Merci pour votre aide...

Cordialement.

Rechercher des sujets similaires à "probleme fonction send vba"