USUÁRIO:      SENHA:        SALVAR LOGIN ?    Adicione o VBWEB na sua lista de favoritos   Fale conosco 

 

  Dicas

  Visual Basic    (Windows)

Título da Dica:  Saber se o MS Office está instalado na máquina
Postada em 29/12/2003 por PC            
Esta dica te retorna se alguma aplicação doMicrosoft Office está instalada.

'Em um module, ponha este código
Option Explicit
Private Declare Function RegOpenKey Lib _
"advapi32" Alias "RegOpenKeyA" (ByVal hKey _
As Long, ByVal lpSubKey As String, _
phkResult As Long) As Long

Private Declare Function RegQueryValueEx _
Lib "advapi32" Alias "RegQueryValueExA" _
(ByVal hKey As Long, ByVal lpValueName As _
String, lpReserved As Long, lptype As _
Long, lpData As Any, lpcbData As Long) _
As Long

Private Declare Function RegCloseKey& Lib _
"advapi32" (ByVal hKey&)

Private Const REG_SZ = 1
Private Const REG_EXPAND_SZ = 2
Private Const ERROR_SUCCESS = 0
Public Const HKEY_CLASSES_ROOT = &H80000000

Public Function GetRegString(hKey As Long, _
strSubKey As String, strValueName As _
String) As String
Dim strSetting As String
Dim lngDataLen As Long
Dim lngRes As Long
If RegOpenKey(hKey, strSubKey, _
lngRes) = ERROR_SUCCESS Then
   strSetting = Space(255)
   lngDataLen = Len(strSetting)
   If RegQueryValueEx(lngRes, _
   strValueName, ByVal 0, _
   REG_EXPAND_SZ, ByVal strSetting, _
   lngDataLen) = ERROR_SUCCESS Then
      If lngDataLen > 1 Then
      GetRegString = Left(strSetting, lngDataLen - 1)
   End If
End If

If RegCloseKey(lngRes) <> ERROR_SUCCESS Then
   MsgBox "RegCloseKey Failed: " & _
   strSubKey, vbCritical
End If
End If
End Function


' em um FORM ponha este código:

Option Explicit
Function FileExists(sFileName$) As Boolean
On Error Resume Next
FileExists = IIf(Dir(Trim(sFileName)) <> "", _
True, False)
End Function

Public Function IsAppPresent(strSubKey$, _
strValueName$) As Boolean
IsAppPresent = CBool(Len(GetRegString(HKEY_CLASSES_ROOT, _
strSubKey, strValueName)))
End Function

Private Sub Command1_Click()

Label1.Caption = "Access " & _
IsAppPresent("Access.Database\CurVer", "")

Label2.Caption = "Excel " & _
IsAppPresent("Excel.Sheet\CurVer", "")

Label3.Caption = "PowerPoint " & _
IsAppPresent("PowerPoint.Slide\CurVer", "")

Label4.Caption = "Word " & _
IsAppPresent("Word.Document\CurVer", "")

End Sub

 


CyberWEB Network Ltda.    © Copyright 2000-2024   -   Todos os direitos reservados.
Powered by HostingZone - A melhor hospedagem para seu site
Topo da página