Accès comptes mail Outlook par VBA

Accès comptes mail Outlook par VBA - VB/VBA/VBS - Programmation

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.

Reply

Marsh Posté le 03-12-2004 à 15:03:54   

Reply

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 ?
 

Reply

Marsh Posté le 10-12-2004 à 13:01:29    

heu comment tu fé :)
ca m'interesse GRAVE :)

Reply

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

Reply

Sujets relatifs:

Leave a Replay

Make sure you enter the(*)required information where indicate.HTML code is not allowed