VB中怎样判断机器上是否装有WORD及WORD是否打开?

Question

在VB6中进行适当引用并写出下列语句后能处理WORD文档：Dim wdApp As Word.Application
Dim aDoc As Document
Set wdApp = New Word.Application但前提是机器上已安装了WORD，所以我希望：1. 在代码中加进判断该机上是否已安装了WORD的语句（WORD的版本及安装在哪个目录下不限），如未安装，告诉用户：“本机上未安装WORD，请先安装后再运行本程序！”；2. 如该机上已安装了WORD，要求在代码中接着判断WORD是否已启动，如已启动，告诉用户：“WORD已启动，请先退出后再运行本程序！”。52分是坛上此次允许给的最高分。

Answer 1

Function install(ByVal exefilename As String) As String
On Error GoTo myerr
Dim WSH As Object
Set WSH = CreateObject("Wscript.Shell")
install = "<" & exefilename & "> was installed in " & WSH.RegRead("HKEY_LOCAL_MACHINE\Software\Microsoft\Windows\CurrentVersion\App Paths\" & exepath & "\Path")
Set WSH = Nothing
Exit Function
myerr:
install = "<" & exefilename & "> was Not installed in my system"
End FunctionSub xxx()
MsgBox install("word.exe")
End Sub

Answer 2

on erroe resume next
Dim wdApp As Object
Dim aDoc As Object
Set wdApp = createobject("Word.Application")if err.Number<>0 then
  msgbox "没有安装Word"
  exit sub
end if

Answer 3

VBToy(无证编程)
逆向思维，此法比较容易理解，楼主可以借鉴

Answer 4

去注册表里面搜索是否有WORD信息

Answer 5

用什么方法可得 Office 组件(Word ,Excel,Access等)所在的目录？？ 
主要解答者: online 提交人: online 
感谢: happyfish21cn、 
审核者: online 社区对应贴子: 查看 
     A :  默认是：  
ffice2k是在"C:\Program  Files\Microsoft  Office\Office"  
officeXP是在"C:\Program  Files\Microsoft  Office\Office10"  
如果不是安装在C盘，或安装时自己改变了目录，又怎样得知？？？  
 
请提供代码  
---------------------------------------------------------------  
 
读注册表  
---------------------------------------------------------------  
 
读注册表  
 
 
模块  
Option  Explicit  
Private  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  
Private  Declare  Function  RegQueryValueEx  Lib  "advapi32.dll"  _  
     Alias  "RegQueryValueExA"  (ByVal  hKey  As  Long,  ByVal  _  
     lpValueName  As  String,  ByVal  lpReserved  As  Long,  _  
     lpType  As  Long,  ByVal  lpData  As  String,  lpcbData  As  Long)  _  
     As  Long  
                                                                                                                                                                                                     
Private  Declare  Function  RegCloseKey  Lib  "advapi32.dll"  _  
     (ByVal  hKey  As  Long)  As  Long  
Private  Const  REG_SZ  As  Long  =  1  
Private  Const  KEY_ALL_ACCESS  =  &H3F  
Private  Const  HKEY_LOCAL_MACHINE  =  &H80000002  
 
Public  Function  GetWordPath()  As  String  
       GetWordPath  =  GetOfficeAppPath("Word.Application")  
End  Function  
Public  Function  GetExcelPath()  As  String  
       GetExcelPath  =  GetOfficeAppPath("Excel.Application")  
End  Function  
Public  Function  GetAccessPath()  As  String  
       GetAccessPath  =  GetOfficeAppPath("Access.Application")  
End  Function  
Public  Function  GetOutlookPath()  As  String  
       GetOutlookPath  =  GetOfficeAppPath("Outlook.Application")  
End  Function  
Public  Function  GetPowerPointPath()  As  String  
       GetPowerPointPath  =  _  
             GetOfficeAppPath("PowerPoint.Application")  
End  Function  
Public  Function  GetFrontPagePath()  As  String  
       GetFrontPagePath  =  GetOfficeAppPath("FrontPage.Application")  
End  Function  
Private  Function  GetOfficeAppPath(ByVal  ProgID  As  String)  _  
     As  String  
Dim  lKey  As  Long  
Dim  lRet  As  Long  
Dim  sClassID  As  String  
Dim  sAns  As  String  
Dim  lngBuffer  As  Long  
Dim  lPos  As  Long  
     'GetClassID  
     lRet  =  RegOpenKeyEx(HKEY_LOCAL_MACHINE,  _  
                   "Software\Classes\"  &  ProgID  &  "\CLSID",  0&,  _  
                     KEY_ALL_ACCESS,  lKey)  
     If  lRet  =  0  Then  
   
           lRet  =  RegQueryValueEx(lKey,  "",  0&,  REG_SZ,  "",  lngBuffer)  
           sClassID  =  Space(lngBuffer)  
           lRet  =  RegQueryValueEx(lKey,  "",  0&,  REG_SZ,  sClassID,  _  
                   lngBuffer)  
           'drop  null-terminator  
           sClassID  =  Left(sClassID,  lngBuffer  -  1)  
           RegCloseKey  lKey  
     End  If  
       
         
     'Get  AppPath  
       lRet  =  RegOpenKeyEx(HKEY_LOCAL_MACHINE,  _  
               "Software\Classes\CLSID\"  &  sClassID  &  _  
               "\LocalServer32",  0&,  KEY_ALL_ACCESS,  lKey)  
   
   If  lRet  =  0  Then  
           lRet  =  RegQueryValueEx(lKey,  "",  0&,  REG_SZ,  "",  lngBuffer)  
           sAns  =  Space(lngBuffer)  
           lRet  =  RegQueryValueEx(lKey,  "",  0&,  REG_SZ,  sAns,  _  
               lngBuffer)  
           sAns  =  Left(sAns,  lngBuffer  -  1)  
             
           RegCloseKey  lKey  
     End  If  
         
       lPos  =  InStr(sAns,  "/")  
               If  lPos  >  0  Then  
                       sAns  =  Trim(Left(sAns,  lPos  -  1))  
               End  If  
         
       GetOfficeAppPath  =  sAns  
         
End  Function  
 
 
测试  
Private  Sub  Command1_Click()  
MsgBox  GetWordPath()  
End  Sub  
 
没有自然返回空

Answer 6

用楼上的代码我试了一下,至少在安装了WORD的机上测试是正确的,明天我再找一台没有安装WORD的机子试一下.
不知第2个问题怎么搞定,即2. 如该机上已安装了WORD，要求在代码中接着判断WORD是否已启动，如已启动，告诉用户：“WORD已启动，请先退出后再运行本程序！”。我用的是(先引用Microsoft Word XX.X Object Library):Dim wdApp As Word.Application
Dim aDoc As Document
Set wdApp = New Word.ApplicationIf Word.Application.Visible = True Then
   MsgBox "WORD已启动，请先退出后再运行本程序！"
   Exit Sub
End If为何第一次运行是对的,再次运行就不行了呢?且运行后,其下在WORD编好并能正确运行的宏就不能正确运行了呢?
有无更好的方法?

Answer 7

国际海员的方法概括了office2k以前的版本么。我喜欢创建对象找错误的方法
第二个你可以在进程中找，如果word启动了就出提示

Answer 8

on erroe resume next
Dim wdApp As Object
Dim aDoc As Object
Set wdApp = createobject("Word.Application")if err.Number<>0 then
  msgbox "没有安装Word"
  exit sub
end if
这个方法最简单

Answer 9

用shell吧 如果已经启动就会返回错误信息 如果没有启动则启动word

Answer 10

我的程序运行前要求先不能启动WORD，所以如果运行前启动了，我希望程序中加进判断：“WORD已启动，请先退出后再运行本程序！”，这用shell应该不行吧？

Answer 11

我是检查进程的，也许不是最好的方法，但是一个方法
声明
Private Type PROCESSENTRY32
    dwSize As Long
    cntUsage As Long
    th32ProcessID As Long
    th32DefaultHeapID As Long
    th32ModuleID As Long
    cntThreads As Long
    th32ParentProcessID As Long
    pcPriClassBase As Long
    dwFlags As Long
    szExeFile As String * 260
End Type
Private Declare Function GetCurrentProcessId Lib "kernel32" () As Long
Private Declare Function CreateToolhelp32Snapshot Lib "kernel32" (ByVal dwFlags As Long, ByVal th32ProcessID As Long) As Long
Private Declare Function Process32First Lib "kernel32" (ByVal hSnapShot As Long, lppe As PROCESSENTRY32) As Long
Private Declare Function Process32Next Lib "kernel32" (ByVal hSnapShot As Long, lppe As PROCESSENTRY32) As Long
Private Declare Function OpenProcess Lib "kernel32" (ByVal dwDesiredAccess As Long, ByVal blnheritHandle As Long, ByVal dwAppProcessId As Long) As Long
Private Declare Function TerminateProcess Lib "kernel32" (ByVal ApphProcess As Long, ByVal uExitCode As Long) As Long
Private Declare Sub CloseHandle Lib "kernel32" (ByVal hPass As Long)Private Const TH32CS_SNAPPROCESS = &H2&
函数，关闭进程
Private Sub KillProcess(sProcess As String)
    Dim lSnapShot As Long
    Dim lNextProcess As Long
    Dim lCurrenProcessID As Long
    Dim tPE As PROCESSENTRY32
    lCurrenProcessID = GetCurrentProcessId
    
    lSnapShot = CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0&)
    If lSnapShot <> -1 Then
        tPE.dwSize = Len(tPE)
        lNextProcess = Process32First(lSnapShot, tPE)
        Do While lNextProcess
          If InStr(1, tPE.szExeFile, sProcess, vbTextCompare) > 0 And tPE.th32ParentProcessID = 904 Then
                Dim lProcess As Long
                Dim lExitCode As Long
                lProcess = OpenProcess(1, False, tPE.th32ProcessID)
                TerminateProcess lProcess, lExitCode
                CloseHandle lProcess '在这里关闭
            End If
            lNextProcess = Process32Next(lSnapShot, tPE)
        Loop
        CloseHandle (lSnapShot)
    End If
End Sub函数调用Call KillProcess("WINWORD.exe")

Answer 12

我本人觉得搜寻注册表的方法有些欠缺，因为随着word版本的不同，注册表项也有所不同，因此读取注册表来检测的方法未免有点局限。
通过能否创建word实例的方法来检测是否安装word更现实点，如果出错，则证明肯定没有安装，至少word不能正常使用。另外，想知道word是否已经运行，其实可以用api来检测系统进程，因为不论哪一版本的word，其实进程都是一样的，所以检测进程是比较现实的。仅供参考～～

Answer 13

CreateObject來判斷是否安裝WORD.GetObject來判斷是否已經打開WORD.

Answer 14

Dim wordApp As Object
    On Error Resume Next
    Set wordApp = GetObject(, "Word.Application")
    If Err.Number <> 0 Then
        Err.Clear
        Set wordApp = CreateObject("Word.Application")
        If Err.Number <> 0 Then
            Err.Clear
            MsgBox "本机上未安装WORD，请先安装WORD XP或WORD更高版本后再运行本程序！", vbInformation
         Exit Sub
       Else
            MsgBox "您的电脑中已安装Word程序!", vbInformation
          wordApp.Quit
       End If
    Else
        MsgBox "WORD已启动，请先退出WORD后再运行本程序！", vbInformation
        wordApp.Quit
       Exit Sub
    End If