Accès comptes mail Outlook par VBA - VB/VBA/VBS - Programmation
Marsh Posté le 03-12-2004 à 17:23:44
 
J'ai trouvé un moyen via la base de registres. 
Par contre, les modif ne sont prises en compte qu'en relançant Outlook. 
Y a-y-il un moyen de faire un espèce de refresh ou reload pour que ça prenne effet immédiatement ? 
 
Marsh Posté le 10-12-2004 à 13:58:39
Private Const HKEY_CURRENT_USER = &H80000001 
 
Private Const REG_SZ = 1 
Private Const REG_DWORD = 4 
 
Private Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long) As Long 
Private Declare Function RegOpenKey Lib "advapi32.dll" Alias "RegOpenKeyA" (ByVal hKey As Long, ByVal lpSubKey As String, phkResult As Long) As Long 
Private Declare Function RegEnumKeyEx Lib "advapi32.dll" Alias "RegEnumKeyExA" (ByVal hKey As Long, ByVal dwIndex As Long, ByVal lpName As String, lpcbName As Long, ByVal lpReserved As Long, ByVal lpClass As String, lpcbClass As Long, lpftLastWriteTime As Any) As Long 
Private Declare Function RegEnumValue Lib "advapi32.dll" Alias "RegEnumValueA" (ByVal hKey As Long, ByVal dwIndex As Long, ByVal lpValueName As String, lpcbValueName As Long, ByVal lpReserved As Long, lpType As Long, lpData As Byte, lpcbData As Long) As Long 
Private Declare Function RegQueryValueEx Lib "advapi32.dll" Alias "RegQueryValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, lpType As Long, lpData As Any, lpcbData As Long) As Long 
Private Declare Function RegSetValueEx Lib "advapi32.dll" Alias "RegSetValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal Reserved As Long, ByVal dwType As Long, lpData As Any, ByVal cbData As Long) As Long 
 
Public Sub ActiverComptesPerso() 
    Dim LcBuffer As String 
    Dim hKey As Long 
    Dim hSousKey As Long 
    Dim LcKeyIndex As Long 
    Dim LcResult As Long 
    Dim LcValueType As Long 
    Dim LcDataBufferSize As Long 
     
    LcKeyIndex = 0 
    RegOpenKey HKEY_CURRENT_USER, "Software\Microsoft\Office\Outlook\OMI Account Manager\Accounts", hKey 
    Do 
        'Create a buffer 
        LcBuffer = String(255, 0) 
        'Enumerate the keys 
        If RegEnumKeyEx(hKey, LcKeyIndex, LcBuffer, 255, 0, vbNullString, ByVal 0&, ByVal 0& ) <> 0 Then Exit Do 
         
        'Open a new key 
        RegOpenKey HKEY_CURRENT_USER, "Software\Microsoft\Office\Outlook\OMI Account Manager\Accounts\" & LcBuffer, hSousKey 
         
        'est-ce un compte perso ? 
        'retrieve information about the key 
        LcResult = RegQueryValueEx(hSousKey, "SMTP Email Address", 0, LcValueType, ByVal 0, LcDataBufferSize) 
        If LcResult = 0 Then 
            'Create a buffer 
            LcBuffer = String(LcDataBufferSize, Chr$(0)) 
            'retrieve the key's content 
            LcResult = RegQueryValueEx(hSousKey, "SMTP Email Address", 0, 0, ByVal LcBuffer, LcDataBufferSize) 
            If Len(LcBuffer) > 1 Then LcBuffer = Left(LcBuffer, Len(LcBuffer) - 1) 
            If InStr("adr1,adr2,...", LcBuffer) > 0 Then 
                'activer le compte 
                LcResult = RegSetValueEx(hSousKey, "POP3 Skip Account", 0, REG_DWORD, CLng(0), 4) 
            End If 
        End If 
         
        'Close the registry 
        RegCloseKey hSousKey 
         
        LcKeyIndex = LcKeyIndex + 1 
    Loop 
    'Close the registry key 
    RegCloseKey hKey 
    MsgBox "Activés ! Il faut relancer Outlook" 
End Sub 
 
Public Sub DesactiverComptesPerso() 
    Dim LcBuffer As String 
    Dim hKey As Long 
    Dim hSousKey As Long 
    Dim LcKeyIndex As Long 
    Dim LcResult As Long 
    Dim LcValueType As Long 
    Dim LcDataBufferSize As Long 
     
    LcKeyIndex = 0 
    RegOpenKey HKEY_CURRENT_USER, "Software\Microsoft\Office\Outlook\OMI Account Manager\Accounts", hKey 
    Do 
        'Create a buffer 
        LcBuffer = String(255, 0) 
        'Enumerate the keys 
        If RegEnumKeyEx(hKey, LcKeyIndex, LcBuffer, 255, 0, vbNullString, ByVal 0&, ByVal 0& ) <> 0 Then Exit Do 
         
        'Open a new key 
        RegOpenKey HKEY_CURRENT_USER, "Software\Microsoft\Office\Outlook\OMI Account Manager\Accounts\" & LcBuffer, hSousKey 
         
        'est-ce un compte perso ? 
        'retrieve information about the key 
        LcResult = RegQueryValueEx(hSousKey, "SMTP Email Address", 0, LcValueType, ByVal 0, LcDataBufferSize) 
        If LcResult = 0 Then 
            'Create a buffer 
            LcBuffer = String(LcDataBufferSize, Chr$(0)) 
            'retrieve the key's content 
            LcResult = RegQueryValueEx(hSousKey, "SMTP Email Address", 0, 0, ByVal LcBuffer, LcDataBufferSize) 
            If Len(LcBuffer) > 1 Then LcBuffer = Left(LcBuffer, Len(LcBuffer) - 1) 
            If InStr("adr1,adr2,...", LcBuffer) > 0 Then 
                'désactiver le compte 
                LcResult = RegSetValueEx(hSousKey, "POP3 Skip Account", 0, REG_DWORD, CLng(1), 4) 
            End If 
        End If 
         
        'Close the registry 
        RegCloseKey hSousKey 
         
        LcKeyIndex = LcKeyIndex + 1 
    Loop 
    'Close the registry key 
    RegCloseKey hKey 
    MsgBox "Desactivés ! Il faut relancer Outlook" 
End Sub 
 
voilà, faut relancer Outlook après
Marsh Posté le 03-12-2004 à 15:03:54
Bonjour,
Comment peut-on accéder aux propriétés des comptes mail (nom, login, serveur pop...) de Outlook via VBA ? Quel objet faut utiliser ?
Merci d'avance.