[分享]FoxMail的内置Word模板源程序

方漠

安装FoxMail后，会在Word里新增加一个工具栏（红色的图标），以方便用户用FoxMail收发邮件。卸载FoxMail后，但其工具栏仍然存在，非常讨厌，于是想法把其弄掉，没想无意中打开其源码，贴在此供有需要的各位分享，以下是其源程序：

Public Const SW_NORMAL = 1

Public Const SW_MINIMIZE = 6

Public Const HKEY_CURRENT_USER = &H80000001

Public Const KEY_QUERY_VALUE = &H1

Public Const REG_SZ = 1                         ' Unicode nul terminated string

Public Declare Function RegOpenKeyEx Lib "advapi32.dll" Alias "RegOpenKeyExA" (ByVal hKey As Long, ByVal lpSubKey As String, ByVal ulOptions As Long, ByVal samDesired As Long, phkResult As Long) As Long

Public 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         ' Note that if you declare the lpData parameter as String, you must pass it By Value.

Public Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long) As Long

Public 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 Foxmail()

'

    On Error Resume Next

'HKEY_CURRENT_USER\Software\Aerofox\FoxMail\V3.1

'FoxMailPath

    Dim hKey As Long

    Dim tmpStr As String * 255

    Dim PathLen As Long

   

    If RegOpenKeyEx(HKEY_CURRENT_USER, "Software\Aerofox\FoxMail\V3.1", 0, KEY_QUERY_VALUE, hKey) <> 0 Then

      Exit Sub

    End If

    PathLen = Len(tmpStr)

    If RegQueryValueEx(hKey, "FoxmailPath", 0, REG_SZ, ByVal tmpStr, PathLen) <> 0 Then

      Exit Sub

      RegCloseKey hKey

    End If

    RegCloseKey hKey

    FoxmailPath = Trim(Left(tmpStr, PathLen))

    ActiveDocument.Save

    If (ActiveDocument.Path <> "") And (ActiveDocument.FullName <> "") Then

      ShellExecute 0, "Open", FoxmailPath, """" & ActiveDocument.FullName & """", "", SW_NORMAL

    End If

End Sub