Vba 如何在Outlook打开2分钟后在Outlook上启动宏

我想在Outlook打开5分钟后运行宏

您可以使用fmsinc提供的此解决方案。我预先准备好了一段代码来做这件事

Public Sub WaitSeconds(intSeconds As Integer)
  ' Comments: Waits for a specified number of seconds
  ' Params  : intSeconds      Number of seconds to wait
  ' Source  : Total Visual SourceBook
  ' Source  : http://www.fmsinc.com/microsoftaccess/modules/examples/avoiddoevents.asp
Private Declare Sub Sleep Lib "kernel32" (ByVal lngMilliSeconds As Long)
  On Error GoTo PROC_ERR

  Dim datTime As Date

  datTime = DateAdd("s", intSeconds, Now)

  Do
   ' Yield to other programs (better than using DoEvents which eats up all the CPU cycles)
    Sleep 100
    DoEvents
  Loop Until Now >= datTime

PROC_EXIT:
  Exit Sub

PROC_ERR:
  MsgBox "Error: " & Err.Number & ". " & Err.Description, , "modDateTime.WaitSeconds"
  Resume PROC_EXIT
End Sub

---

在Outlook打开时，我有一个代码，可以在excel上启动宏

  Private Sub Application_Startup()
Dim ExApp As Excel.Application
 Dim ExWbk As Workbook
 Set ExApp = New Excel.Application
 Set ExWbk = ExApp.Workbooks.Open("C:\Users\z003zj4s\Desktop\MICHEL PACQUET\Nouveau dossier\MichelPaquet.xlsm")
 ExApp.Visible = False
 ExWbk.Application.Run "Module1.TEST1"
 ExWbk.Close SaveChanges:=True
End Sub

在excel上启动的宏实际上正在使用outlook发送邮件

Sub TEST1()
    Dim Plage_de_recherche As Range ' correspond à la plage de recherche
    Dim Valeur_cherchée As String ' correspond à ce que l'on cherche
    Dim Trouvé As Range ' c'est le résultat de la recherche
    Dim La_colonne As Integer ' colonne du mois où il y a "ok"

    Dim OutApp As Object
    Dim OutMail As Object
    Dim strbody As String


    Valeur_cherchée = "ORANGE" 'définition de ce que l'on cherche
    Set Plage_de_recherche = Sheets("Feuil1").Range("J2:J58") ' définition de la plage de recherche
    Set Trouvé = Plage_de_recherche.Find(what:=Valeur_cherchée, LookIn:=xlValues) ' on effectue la recherche : xlvalues car ok est le résultat d'une formule
    If Trouvé Is Nothing Then ' si Trouvé = rien c'est qu'on a rien trouvé...
        ' ce qu'il y a à faire si on ne trouve pas "OK"
    Else

    Set OutApp = CreateObject("Outlook.Application")
    Set OutMail = OutApp.CreateItem(0)

    strbody = "Bonjour Michel," & vbCrLf & _
    " " & vbCrLf & _
    "La date de péremption de certain documents approche," & vbCrLf & _
    "Vérifiez si une nouvelle version à été mise en ligne." & vbCrLf & " " & vbCrLf & _
    "Cordialement," & vbCrLf & _
    "Excel"

    On Error Resume Next
    With OutMail
        .To = "armand.akdogan@siemens.com"
        .CC = ""
        .BCC = ""
        .Subject = "MISE A JOUR DES DOCUMENTS"
        .Body = strbody
        'You can add a file like this
        '.Attachments.Add ("C:\test.txt")
        .Send
    End With
    On Error GoTo 0

    Set OutMail = Nothing
    Set OutApp = Nothing
        ' ce qu'il faut faire si on trouve
    End If
End Sub

突然宏阻塞，因为Outlook尚未打开，并给出

---

“运行时错误'429'：ActiveX组件无法创建对象。”

请编辑您的问题并将所有内容放在那里，而不是作为单独的答案。