'----------------------------------------------------
'Source:
'http://www.tek-tips.com/viewthread.cfm?qid=794484
'
'----------------------------------------------------
 
Private Declare Function NetScheduleJobAdd Lib "netapi32.dll" _
    (ByVal Servername As String, Buffer As Any, JobID As Long) As Long
 
 
Private Type AT_INFO
    JobTime As Long
    DaysOfMonth As Long
    DaysOfWeek As Byte
    Flags As Byte
    Command As String
End Type
 
 
Private Enum JobAdd
    JOB_RUN_PERIODICALLY = 1&
    JOB_ADD_CURRENT_DATE = 8&
    JOB_NONINTERACTIVE = 16&
End Enum
 
 
Private Enum sjWeekdays
    Monday = 1
    Tuesday = 2
    Wednesday = 4
    Thursday = 8
    Friday = 16
    Saturday = 32
    Sunday = 64
End Enum
 
 
Private Enum sjDays
    d1 = 1
    d2 = 2
    d3 = 4
    d4 = 8
    d5 = 16
    d6 = 32
    d7 = 64
    d8 = 128
    d9 = 256
    d10 = 512
    d11 = 1024
    d12 = 2048
    d13 = 4096
    d14 = 8192
    d15 = 16384
    d16 = 32768
    d17 = 65536
    d18 = 131072
    d19 = 262144
    d20 = 524288
    d21 = 1048576
    d22 = 2097152
    d23 = 4194304
    d24 = 8388608
    d25 = 16777216
    d26 = 33554432
    d27 = 67108864
    d28 = 134217728
    d29 = 268435456
    d30 = 536870912
    d31 = 1073741824
End Enum
 
 
 
Sub Test()
    '(ouverture du bloc notes)
    'Tache ponctuelle dans une minute (ouverture du bloc notes)
    vbScheduleJob "notepad.exe", DateAdd("n", 1, Now), JOB_ADD_CURRENT_DATE

    'vbScheduleJob "notepad.exe", DateAdd("n", 1, Now), JOB_RUN_PERIODICALLY, Wednesday, d4
End Sub
 
 
Private Function vbScheduleJob(strCommand As String, sjTime As Date, _
    AddFlags As JobAdd, Optional DayOfWeek As sjWeekdays = 0, _
    Optional DayOfMonth As sjDays = 0, Optional PCName As String = vbNullString) As Long
    
    Dim myInfo As AT_INFO
    Dim JobID As Long
    
    With myInfo
        .Command = StrConv(strCommand, vbUnicode)
        .Flags = AddFlags
        .JobTime = DateDiff("s", "00:00:00", Format(sjTime, "hh:mm:ss")) * 1000
        .DaysOfWeek = DayOfWeek
        .DaysOfMonth = DayOfMonth
    End With
    
    NetScheduleJobAdd PCName, myInfo, JobID
    
    vbScheduleJob = JobID
End Function

Option Explicit

Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" _
    (ByVal hwnd As Long, ByVal lpOperation As String, _
    ByVal lpFile As String, ByVal lpParameters As String, _
    ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long


Sub afficherImage_ApercuWindows()
    'Testé avec Excel2002 et WinXP
    'force l'affichage de l'image avec "L'aperçu des images et des télécopies windows".
    Dim Img As String
    
    Img = "C:\Documents and Settings\nom_utilisateur\dossier\nomfichier.bmp"
    ShellExecute 0, "open", "rundll32.exe", _
        "C:\WINDOWS\System32\shimgvw.dll,ImageView_Fullscreen " & Img, 0, 1
End Sub

Sub listerStatutsPorts()
    Dim Cmd As String
    Dim retVal As Long
        
    Cmd = Environ("COMSPEC") & " /C "
    retVal = Shell(Cmd & "NETSTAT -na> C:\listePorts.txt")
    DoEvents
    ThisWorkbook.FollowHyperlink "C:\listePorts.txt"
End Sub

'*********************
'Sources: http://support.microsoft.com/kb/466935/fr
'
'adapté pour une utilisation en VBA Excel
'*********************

Option Explicit

'lptstrFilename: adresse du nom de fichier
'dwHandle: handle d'information sur la version
'dwLen: taille du strBuffer contenant l'information
'lpData: adresse du premier octet du strBuffer contenant l'information
Private Declare Function GetFileVersionInfo Lib "Version.dll" Alias _
    "GetFileVersionInfoA" (ByVal lptstrFilename As String, ByVal dwHandle As Long, _
    ByVal dwLen As Long, lpData As Any) As Long

'La fonction GetFileVersionInfoSize détermine si les informations sur la
'version existent. Si c'est le cas, cette fonction retourne la taille du
'strBuffer contenant l'information et le handle d'information que l'on
'passera à L'API GetFileVersionInfo. Cette dernière permet de récupérer
'les informations sur la version.
'lptstrFilename: adresse du nom de fichier
'lpdwHandle: adresse du handle d'information sur la version
Private Declare Function _
    GetFileVersionInfoSize Lib "Version.dll" Alias "GetFileVersionInfoSizeA" _
    (ByVal lptstrFilename As String, lpdwHandle As Long) As Long


'La fonction VerQueryValue retourne la partie d'information sur la version:
    'lpvBlock: adresse du premier octet du strBuffer contenant l'information
    'lpszSubBlock: adresse de la partie de l'information qui nous intéresse
    'lplpstrBuffer: adresse du strBuffer contenant la valeur demandée
    'lpcb: adresse de la taille du strBuffer contenant la valeur demandée
Private Declare Function VerQueryValue Lib "Version.dll" Alias "VerQueryValueA" _
    (pBlock As Any, ByVal lpSubBlock As String, lplpstrBuffer As Any, puLen As Long) As Long

Private Declare Sub MoveMemory Lib "kernel32" Alias "RtlMoveMemory" (dest As Any, _
    ByVal Source As Long, ByVal Length As Long)

Private Declare Function lstrcpy Lib "kernel32" Alias "lstrcpyA" _
    (ByVal lpString1 As String, ByVal lpString2 As Long) As Long

Public Declare Function FindExecutableA Lib "shell32.dll" (ByVal lpFile As String, _
    ByVal lpdirectory As String, ByVal lpResult As String) As Long

Public Const MAX_FILENAME_LEN = 256



Function DescriptionAppli(ByVal Cible As String, ByVal Donnee As String) As String
    
    Dim s As String, strW As String, strBuffer As String, Lc As String
    Dim Rc As Long, x As Long, p As Long, j As Long, i As Long
    Dim byteTabBuffer(255) As Byte
    Dim TabBuffer() As Byte
    
    s = Donnee
    
    j = GetFileVersionInfoSize(Cible, i)
    If j < 1 Then Exit Function
    
    ReDim TabBuffer(j)
    Rc = GetFileVersionInfo(Cible, 0&, j, TabBuffer(0))
    If Rc = 0 Then
        DescriptionAppli = False
        Exit Function
    End If
    
    Rc = VerQueryValue(TabBuffer(0), "\VarFileInfo\Translation", p, j)
    If Rc = 0 Then Exit Function
    
    MoveMemory byteTabBuffer(0), p, j
    
    x = byteTabBuffer(2) + byteTabBuffer(3) * &H100 + byteTabBuffer(0) * _
        &H10000 + byteTabBuffer(1) * &H1000000
        
    Lc = Hex(x)
        
    Do While Len(Lc) < 8
        Lc = "0" & Lc
    Loop
    
    strBuffer = String(255, 0)
    strW = "\StringFileInfo\" & Lc & "\" & s
    Rc = VerQueryValue(TabBuffer(0), strW, p, j)
    
    If Rc = 0 Then Exit Function
    
    lstrcpy strBuffer, p
    strBuffer = Mid$(strBuffer, 1, InStr(strBuffer, Chr(0)) - 1)
    
    DescriptionAppli = strBuffer
End Function


Function FindExecutable(s As String) As String
    Dim i As Integer
    Dim S2 As String
    
    S2 = String(MAX_FILENAME_LEN, 32) & Chr$(0)
    i = FindExecutableA(s & Chr$(0), vbNullString, S2)
    
    If i > 32 Then
        FindExecutable = Left$(S2, InStr(S2, Chr$(0)) - 1)
        Else
        FindExecutable = ""
    End If
End Function



Sub AfficherInformationsApplication()
    Dim Resultat As String, MonAppli As String, LeFichier As String
    Dim x As Variant, Tableau As Variant
    Dim i As Integer
    
    Tableau = Array("Comments", "CompanyName", "FileDescription", "FileVersion", _
        "InternalName", "LegalCopyright", "LegalTrademarks", "PrivateBuild", _
        "OriginalFileName", "ProductName", "productVersion", "SpecialBuild")
    
    x = Application.GetOpenFilename
    If x = False Then Exit Sub
    
    LeFichier = x
    MonAppli = FindExecutable(LeFichier)
    
    For i = LBound(Tableau) To UBound(Tableau)
        Resultat = Resultat & Tableau(i) & " :  " & _
        DescriptionAppli(MonAppli, Tableau(i)) & vbLf
    Next i
    
    MsgBox Resultat, , "Informations : " & MonAppli
End Sub

Sub versionApplication()
    Dim Fso As Object
    
    Set Fso = CreateObject("Scripting.fileSystemObject")
    MsgBox Fso.getFileVersion("C:\WINDOWS\system32\calc.exe")
End Sub

Sub SystemeExploitation()
    Dim WmObj As Object, Cible As Object
    Dim Obj As Object
     
    Set WmObj = GetObject("WinMgmts:{impersonationLevel=impersonate}")
    Set Cible = WmObj.ExecQuery("Select * from Win32_OperatingSystem")
     
    For Each Obj In Cible
        MsgBox Left(Obj.Name, InStr(1, Obj.Name, "|") - 1) & _
            vbCrLf & Obj.Version
    Next
End Sub

Dim i As Integer

For i = 1 To 30
    Cells(i, 1) = Environ(i)
Next i

'Nom de l'utilisateur qui a ouvert la session Windows.
MsgBox Environ("USERNAME")