-天気予報コム-

Flag counter

« Windows 7 64bit版 SP1適用 | トップページ | HP iPAQ Voice Messengerの互換電池を探してみた »

Windowsのバージョン情報とOfficeのバージョン情報を取得するスクリプトをvbsで作ってみた

 仕事場で、ITトラブル対応を受ける際に、申込用紙を書いて貰っています。が、Windowsのバージョン情報やOfficeのバージョン情報をサービスパックまで正確に記入している人は皆無です。ということで、誰でも簡単にWindowsのバージョン情報とOfficeのバージョン情報を知ることが出来るスクリプトをvbsで作ってみました。
 こんな感じです。

Win_ver

Office_ver

 OSは32bit/64bit、エディション、サービスパックまで出ます。言語も日・英・仏は出ます。私の環境じゃココまで判別付ければいいので、それ以外の言語は"Other"で出力するようにしました。
 OfficeはOfficeのインストールパスとWINWORD.EXEのファイルバージョンで判別してますが、うまいこと行ってません、unknownって出てるし。実際ネットで調べた際のOffice2003SP3のWINWORD.EXEのファイルバージョンと私の環境のバージョンが違っているみたいです。ウチの環境だと日本語版Office 2003ProSP3に仏語のMUIを入れたからかも知れませんが。

 ちなみにOSの情報を取得するクラスに関しては以下が参考になりました。
http://msdn.microsoft.com/en-us/library/Aa394239

 まぁ、分かる人にはかなりいい加減だとバレバレですが、とりあえずソースを公開しておきます。コメントアウトしたとこもそのまま載っけておきます。以下を適当な名前でテキストエディタにて保存して(シフトJIS、改行コードはCR+LFね)、hoge.vbsみたいな感じでリネームして保存後ダブルクリックすれば動くはずです。
 WindowsはXP(32bit)、Vista(32bit)、7(32/64bit)でのみ確認(XP以降なら大体大丈夫だと思いますが)、Officeは2003、2007、2010でのみ確認してます。まぁ、Office2000とOfficeXPでも動くはずですが。
 ここにもソースをアップしておきました。


Option Explicit
' check Windows & Office Version and some additional information
' 2011/02/19 made by platon

Dim WSHShell
Dim strOS
Dim strSP
Dim strOSLang
Dim vbCrLf
Dim xlApp
Dim strOffice
Dim lngOfficeLangID
Dim strOfficeLang
Dim msoLanguageIDInstall
Dim OSInfoCollection
Dim OSInfo
Dim str3264bit
Dim strWordVersion
Dim strWordVersionDetail

vbCrLf = Chr(13) & Chr(10)
msoLanguageIDInstall = 1

Set WSHShell = WScript.CreateObject("WScript.Shell")
Set OSInfoCollection = GetObject("winmgmts:").InstancesOf("Win32_OperatingSystem")

str3264bit = WshShell.Environment("PROCESS").Item("ProgramFiles(x86)")
If str3264bit <> "" Then
str3264bit = "64bit"
Else
str3264bit = "32bit"
End If


For Each OSInfo In OSInfoCollection 'Loop is simply to reffer the first member of collection
strOS = OSInfo.Caption
strSP = OSInfo.CSDVersion

If CInt(OSInfo.OSLanguage) = 1041 Then
strOSLang = "Japanese"
ElseIf CInt(OSInfo.OSLanguage) = 1033 Then
strOSLang = "English(US)"
ElseIf CInt(OSInfo.OSLanguage) = 1036 Then
strOSLang = "French"
ElseIf CInt(OSInfo.OSLanguage) = 2057 Then
strOSLang = "English(UK)"
Else
strOSLang = "Other (" & CInt(OSInfo.OSLanguage) & ")"
End If

Next

MsgBox "Windows version: " & strOS & vbCrLf & _
"32bit/64bit: " & str3264bit & vbCrLf &_
"Service Pack: " & strSP & vbCrLf & _
"Language: " & strOSLang


strWordVersion = strGetWordVersion
If strWordVersion = "" Then
MsgBox "No Office is installed!"
Set WSHShell = Nothing
Set OSInfoCollection = Nothing
WScript.Quit
Else
strWordVersionDetail = strCheckWordVersion(strWordVersion)
End If

Set xlApp = CreateObject("Excel.Application")


'Select Case xlApp.Version
' Case "14.0"
' strOffice = "Office 2010"
' Case "13.0"
' strOffice = "Office 2007"
' Case "12.0"
' strOffice = "Office 2003"
' Case "11.0"
' strOffice = "Office XP"
' Case "10.0"
' strOffice = "Office 2000"
'End Select

lngOfficeLangID = xlApp.LanguageSettings.LanguageID(msoLanguageIDInstall)

If lngOfficeLangID = 1041 Then
strOfficeLang = "Japanese"
ElseIf lngOfficeLangID = 1033 Then
strOfficeLang = "English(US)"
ElseIf lngOfficeLangID = 1036 Then
strOfficeLang = "French"
ElseIf lngOfficeLangID = 2057 Then
strOfficeLang = "French"
Else
strOfficeLang = "Other Lang"
End If

MsgBox "Microsoft Office version: " & strWordVersionDetail & vbCrLf & _
"Language: " & strOfficeLang
xlApp.Quit()


' liberate object
Set WSHShell = Nothing
Set OSInfoCollection = Nothing
Set xlApp = Nothing

'----------------------------------------
Function strCheckWordVersion(strVersion)
' check Word detail version
' terget version is below
' WORD 2000, 2002(XP), 2003, 2007 ,2010
'
'----------------------------------------
Const Word2000Rel = "9.0.0.2720"
Const Word2000SR1 = "9.0.0.3821"
Const Word2000SP2 = "9.0.0.4402"
Const Word2000SP3 = "9.0.0.6926"

Const Word2002Rel = "10.0.2627.0"
Const Word2002SP1 = "10.0.3416.0"
Const Word2002SP2 = "10.0.4219.0"
Const Word2002SP3 = "10.0.6612.0"

Const Word2003Rel = "11.0.5604.0"
Const Word2003SP1 = "11.0.6359.0"
Const Word2003SP2 = "11.0.7969.0"
Const Word2003SP3 = "11.0.8173.0"

Const Word2007Rel = "12.0.4518.1014"
Const Word2007SP1 = "12.0.6211.1000"
Const Word2007SP2 = "12.0.6425.1000"

Const Word2010Rel = "14.0.5123.5000"

strCheckWordVersion = ""

Select Case strVersion

Case Word2000Rel
strCheckWordVersion = "Office2000"
Exit Function

Case Word2000SR1
strCheckWordVersion = "Office2000 SR-1"
Exit Function

Case Word2000SP2
strCheckWordVersion = "Office2000 SP2"
Exit Function

Case Word2000SP3
strCheckWordVersion = "Office2000 SP3"
Exit Function

Case Word2002Rel
strCheckWordVersion = "OfficeXP"
Exit Function

Case Word2002SP1
strCheckWordVersion = "OfficeXP SP1"
Exit Function

Case Word2002SP2
strCheckWordVersion = "OfficeXP SP2"
Exit Function

Case Word2002SP3
strCheckWordVersion = "OfficeXP SP3"
Exit Function

Case Word2003Rel
strCheckWordVersion = "Office2003"
Exit Function

Case Word2003SP1
strCheckWordVersion = "Office2003 SP1"
Exit Function

Case Word2003SP2
strCheckWordVersion = "Office2003 SP2"
Exit Function

Case Word2003SP3
strCheckWordVersion = "Office2003 SP3"
Exit Function

Case Word2007Rel
strCheckWordVersion = "Office2007"
Exit Function

Case Word2007SP1
strCheckWordVersion = "Office2007 SP1"
Exit Function

Case Word2007SP2
strCheckWordVersion = "Office2007 SP2"
Exit Function

Case Word2010Rel
strCheckWordVersion = "Office2010"
Exit Function
End Select

If CInt(Left(strVersion, 1)) = 9 Then
strCheckWordVersion = "Office2000 unknown"

ElseIf CInt(Left(strVersion, 2)) = 10 Then
strCheckWordVersion = "Office2002 unknown"

ElseIf CInt(Left(strVersion, 2)) = 11 Then
strCheckWordVersion = "Office2003 unknown"

ElseIf CInt(Left(strVersion, 2)) = 12 Then
strCheckWordVersion = "Office2007 unknown"

ElseIf CInt(Left(strVersion, 2)) = 14 Then
strCheckWordVersion = "Office2010 unknown"
End If


End Function

'----------------------------------------
Function strGetWordVersion()
' check Word version
' terget version is below
' WORD 2000, 2002(XP), 2003, 2007 ,2010
'
'----------------------------------------
Dim objFso
Dim objWshShell
Dim strWordPath(4)
Dim varPath
Dim strProgramPath(1)
Dim varProgramPath
Dim strWordName
' Dim strGetWordVersion
Dim intCnt1
Dim intCnt2

strGetWordVersion = ""
strWordName = "WINWORD.EXE"
strWordPath(0) = "\Microsoft Office\Office\"
strWordPath(1) = "\Microsoft Office\Office10\"
strWordPath(2) = "\Microsoft Office\Office11\"
strWordPath(3) = "\Microsoft Office\Office12\"
strWordPath(4) = "\Microsoft Office\Office14\"
strProgramPath(0) = "%ProgramFiles%"
strProgramPath(1) = "%ProgramFiles(x86)%"
varProgramPath = ""


Set objFso = CreateObject("Scripting.FileSystemObject")
Set objWshShell = CreateObject("WScript.Shell")


For intCnt1 = 0 To 4
For intCnt2 = 0 To 1
varProgramPath = objWshShell.ExpandEnvironmentStrings(strProgramPath(intCnt2))
If varProgramPath <> "" Then
If objFso.FileExists(varProgramPath & strWordPath(intCnt1) & strWordName) Then

' get file version
strGetWordVersion = objFso.GetFileVersion(varProgramPath & strWordPath(intCnt1) & strWordName)
' MsgBox varProgramPath & strWordPath(intCnt1) & strWordName & " version is " & strGetWordVersion
Exit For
End If
End If

Next
Next

' If strGetWordVersion = "" Then
' MsgBox "Word doesn't exist!"
' End If


Set objFso = Nothing
Set objWshShell = Nothing

End Function

« Windows 7 64bit版 SP1適用 | トップページ | HP iPAQ Voice Messengerの互換電池を探してみた »

「パソコン・インターネット」カテゴリの記事

コメント

コメントを書く

コメントは記事投稿者が公開するまで表示されません。

(ウェブ上には掲載しません)

« Windows 7 64bit版 SP1適用 | トップページ | HP iPAQ Voice Messengerの互換電池を探してみた »

無料ブログはココログ
2016年11月
    1 2 3 4 5
6 7 8 9 10 11 12
13 14 15 16 17 18 19
20 21 22 23 24 25 26
27 28 29 30