Bonsoir à tous,
J'ai laissé pour un moment le premier post dont lequel je cherche encore une solution pour planifier des tâches en utilisant Excel et les fichiers Batch :
https://www.excel-downloads.com/threads/planifier-des-taches-avec-fichier-batch-et-excel.182918/
Et j'ai ouvert ce nouveau post, parce que j'ai trouvé un code VBA qui peut créer des tâches planifiées avec le planificateur Windows mais le code après adaptation contient encore des lacunes :
1 - Les tâches sont créées pour s'exécuter périodiquement, or j'aimerais que chaque tâche soit exécutée selon le délai défini.
Par exemple : à 22:12:10 le 22/04/2012
Et qu'elle sera détruite après.
2 - Une fois le délai venu, j'ai un message d'erreur dans "Etat" me disant "N'a pas pu démarrer"
Je crois qu'il faut configurer la session dans laquelle sera exécutée la tâche.
	
	
	
	
	
		
Macro TraitementTache :
	
	
	
	
	
		
	
		
			
		
		
	
				
			J'ai laissé pour un moment le premier post dont lequel je cherche encore une solution pour planifier des tâches en utilisant Excel et les fichiers Batch :
https://www.excel-downloads.com/threads/planifier-des-taches-avec-fichier-batch-et-excel.182918/
Et j'ai ouvert ce nouveau post, parce que j'ai trouvé un code VBA qui peut créer des tâches planifiées avec le planificateur Windows mais le code après adaptation contient encore des lacunes :
1 - Les tâches sont créées pour s'exécuter périodiquement, or j'aimerais que chaque tâche soit exécutée selon le délai défini.
Par exemple : à 22:12:10 le 22/04/2012
Et qu'elle sera détruite après.
2 - Une fois le délai venu, j'ai un message d'erreur dans "Etat" me disant "N'a pas pu démarrer"
Je crois qu'il faut configurer la session dans laquelle sera exécutée la tâche.
		Code:
	
	
	Option Explicit 
Private Declare Function NetScheduleJobAdd& Lib "netapi32.dll" _ 
                                            (ByVal Servername$, Buffer As Any, JobID&) 
Private Declare Function GetComputerName& Lib "kernel32" Alias _ 
                                          "GetComputerNameA" (ByVal lpBuffer$, nSize&) 
Private Type AT_INFO 
    JobTime As Long 
    DaysOfMonth As Long 
    DaysOfWeek As Byte 
    Flags As Byte 
    dummy As Integer 
    command As String 
End Type 
Private Sub CreateTask(H$, D$, F$, Optional I As Boolean = False, Optional P As Boolean = True) 
    Dim Start$, Jrs$(), dWeek() As Variant 
    Dim j%, w%, AT As AT_INFO, JobID&, Computer$ 
    Computer = StrConv(ComputerName, vbUnicode) 
    MsgBox "Computer " & Computer 
    dWeek = Array("M", "T", "W", "TH", "F", "S", "SU") 
    With AT 
        Start = Format(H, "hh:mm") 
        .JobTime = (Hour(Start) * 3600 + Minute(Start) * 60) * 1000 
        Jrs = Split(D, ",") 
        ' Dates de chaque mois 
        If Val(D) Then 
            For j = 0 To UBound(Jrs) 
                .DaysOfMonth = .DaysOfMonth + 2 ^ (Jrs(j) - 1) 
            Next 
            ' Jours de chaque semaine 
        Else 
            For j = 0 To UBound(Jrs) 
                For w = 0 To UBound(dWeek) 
                    If UCase(Jrs(j)) = dWeek(w) Then 
                        .DaysOfWeek = .DaysOfWeek + 2 ^ w 
                    End If 
                Next 
            Next 
        End If 
        ' Interactivité 
        If Not I Then .Flags = .Flags Or &H10 
        ' Periodicité 
        If P Then .Flags = .Flags Or &H1 
        .command = StrConv(F, vbUnicode) 
    End With 
    If NetScheduleJobAdd(Computer, AT, JobID) Then 
        MsgBox "Impossible de créer la Tâche !", 64 
    Else 
        MsgBox "Tâche (" & JobID & ") ajoutée !", 64 
    End If 
End Sub 
Private Function ComputerName() As String 
    Dim PCName As String 
    PCName = String(50, Chr(0)) 
    GetComputerName PCName, 50 
    ComputerName = "\\" & Trim(PCName) 
End Function 
Sub AddScheduledTask() 
    Dim iTime$, iFreq$, iProg$ 
    Dim Cel As Range 
    '---- 
    For Each Cel In Range("A2:A" & [A65000].End(xlUp).Row) 
        iTime = Right(Cel, 8) 
        iFreq = Day(Left(Cel, 8)) 
        iProg = "TestDates.xls!TraitementTache" 
        CreateTask iTime, iFreq, iProg 
    Next Cel 
    '---- 
End SubMacro TraitementTache :
		Code:
	
	
	Option Explicit
'------------------------------------------
Sub TraitementTache()
    Dim Frm As Date
    Dim Rg As Range
    With Feuil1
        .Activate
        Frm = Format(Now, "dd/mm/yy hh:mm:ss")
        'Frm = Date
        ThisWorkbook.Application.Visible = True
        Set Rg = .Range("A:A").Find(What:=Frm, LookIn:=xlFormulas, LookAt:=xlPart)
        If Not Rg Is Nothing Then
            'MsgBox "La date " & Frm & " est trouvée à l'adresse " & Rg.Address
            MsgBox "Vous avez un rendez-vous " & Rg.Offset(0, 1).Value
        Else
            MsgBox "La date : " & Frm & " n'a pas été trouvée"
        End If
    End With
   ThisWorkbook.Close
End Sub
'------------------------------------------ 
	 
 
		 
 
		 
 
		 
 
		 
 
		 
 
		 
 
		 
 
		