Detecting Vista

[PC User]

I've seen a number of codes to detect the current operating system,
but they haven't been updated to detect vista. One of the more
commonly referred codes at The Access Web http://www.mvps.org/access/api/api0055.htm
; however, it doesn't detect vista. Does anyone have a code to detect
the current windows version that includes Vista?

Thanks,
PC

 

[Douglas J. Steele]

Vista should be

.dwMajorVersion = 5 And _
.dwMinorVersion = 2 Then

(I think the code from "The Access Web" identifies it as ""Windows .NET
Server ")

 

[Ron Hinds]

Are you sure about that? I thought it was

..dwMajorVersion = 6 And _
..dwMinorVersion = 0 Then

 

[Douglas J. Steele]

You're absolutely right. 5 & 2 is Windows 2003. Don't know what I was
thinking of.

Thanks for the assist. (Sorry for the misinformation, PC User!)

 

[PC User]

It sounds like I need to add some code the referenced procedure.
Would it be something like this?
If .dwPlatformId = VER_PLATFORM_WIN32_WINDOWS And _
.dwMajorVersion = 6 And _
.dwMinorVersion = 0 Then
strOut = "Windows Vista (Version " & _
.dwMajorVersion & "." & .dwMinorVersion & _
") Build " & .dwBuildNumber
If (Len(.szCSDVersion)) Then
strOut = strOut & " (" & _
fTrimNull(.szCSDVersion) & ")"
End If
End If

Thanks,
PC

 

[Douglas J. Steele]

Exactly.

 

[Dirk Goldgar]

It sounds like I need to add some code the referenced procedure.
Would it be something like this?
If .dwPlatformId = VER_PLATFORM_WIN32_WINDOWS And _
.dwMajorVersion = 6 And _
.dwMinorVersion = 0 Then
strOut = "Windows Vista (Version " & _
.dwMajorVersion & "." & .dwMinorVersion & _
") Build " & .dwBuildNumber
If (Len(.szCSDVersion)) Then
strOut = strOut & " (" & _
fTrimNull(.szCSDVersion) & ")"
End If
End If

That's good, except that I've found that the code concerned with
..szCSDVersion (whatever that is) isn't right. I modified the code as
follows:

'----- start of modified code (summarized) -----

Dim strCSDVersion As String

' ...

With osvi

strCSDVersion = fTrimNull(.szCSDVersion)
If (Len(strCSDVersion)) Then
strCSDVersion = " (" & strCSDVersion & ")"
End If

' ...

' Vista
If .dwPlatformId = VER_PLATFORM_WIN32_NT And _
.dwMajorVersion = 6 And _
.dwMinorVersion = 0 Then
strOut = "Windows Vista (Version " & _
.dwMajorVersion & "." & .dwMinorVersion & _
") Build " & .dwBuildNumber & strCSDVersion
End If

'----- end of modified code (summarized) -----

I made similar changes (concatenating strCSDVersion into strOut) in the
other OS versions to which it applies.

 

[PC User]

I tried using this function on a field on a form and activating it by
the On Load form event using Me.txtWindowsVersion = fOSName() and it
doesn't work. What am I doing wrong? See code below.

Code
'=========================
Option Compare Database

' ******** Code Start ********
'This code was originally written by Dev Ashish.
'It is not to be altered or distributed,
'except as part of an application.
'You are free to use it in any application,
'provided the copyright notice is left unchanged.
'
'Code Courtesy of
'Dev Ashish
'

Private Type OSVERSIONINFO
dwOSVersionInfoSize As Long
dwMajorVersion As Long
dwMinorVersion As Long
dwBuildNumber As Long
dwPlatformId As Long
szCSDVersion As String * 128
End Type

Private Declare Function apiGetVersionEx Lib "kernel32" _
Alias "GetVersionExA" _
(lpVersionInformation As Any) _
As Long

Private Const VER_PLATFORM_WIN32_WINDOWS = 1
Private Const VER_PLATFORM_WIN32_NT = 2

'==================================================

Function fOSName() As String
Dim osvi As OSVERSIONINFO
Dim strOut As String
Dim strCSDVersion As String

osvi.dwOSVersionInfoSize = Len(osvi)
If CBool(apiGetVersionEx(osvi)) Then
With osvi

strCSDVersion = fTrimNull(.szCSDVersion)
' Win 2000
If .dwPlatformId = VER_PLATFORM_WIN32_NT And _
.dwMajorVersion = 5 Then
strOut = "Windows 2000 (Version " & _
.dwMajorVersion & "." & .dwMinorVersion & _
") Build " & .dwBuildNumber
If (Len(.szCSDVersion)) Then
strOut = strOut & " (" & _
fTrimNull(.szCSDVersion) & ")"
End If
End If
' XP
If .dwPlatformId = VER_PLATFORM_WIN32_NT And _
.dwMajorVersion = 5 And _
.dwMinorVersion = 1 Then
strOut = "Windows XP (Version " & _
.dwMajorVersion & "." & .dwMinorVersion & _
") Build " & .dwBuildNumber
If (Len(.szCSDVersion)) Then
strOut = strOut & " (" & _
fTrimNull(.szCSDVersion) & ")"
End If
End If
' .Net Server
If .dwPlatformId = VER_PLATFORM_WIN32_NT And _
.dwMajorVersion = 5 And _
.dwMinorVersion = 2 Then
strOut = "Windows .NET Server (Version " & _
.dwMajorVersion & "." & .dwMinorVersion & _
") Build " & .dwBuildNumber
If (Len(.szCSDVersion)) Then
strOut = strOut & " (" & _
fTrimNull(.szCSDVersion) & ")"
End If
End If
' Win ME
If (.dwMajorVersion = 4 And _
(.dwPlatformId = VER_PLATFORM_WIN32_WINDOWS And _
.dwMinorVersion = 90)) Then
strOut = "Windows Millenium"
End If
' Win 98
If (.dwMajorVersion = 4 And _
(.dwPlatformId = VER_PLATFORM_WIN32_WINDOWS And _
.dwMinorVersion = 10)) Then
strOut = "Windows 98"
End If
' Win 95
If (.dwPlatformId = VER_PLATFORM_WIN32_WINDOWS And _
.dwMinorVersion = 0) Then
strOut = "Windows 95"
End If
' Win NT
If (.dwPlatformId = VER_PLATFORM_WIN32_NT And _
.dwMajorVersion <= 4) Then
strOut = "Windows NT " & _
.dwMajorVersion & "." & .dwMinorVersion & _
" Build " & .dwBuildNumber
If (Len(.szCSDVersion)) Then
strOut = strOut & " (" & _
fTrimNull(.szCSDVersion) & ")"
End If
'*************************************************************************
' Vista
If .dwPlatformId = VER_PLATFORM_WIN32_NT And _
.dwMajorVersion = 6 And _
.dwMinorVersion = 0 Then
strOut = "Windows Vista (Version " & _
.dwMajorVersion & "." & .dwMinorVersion & _
") Build " & .dwBuildNumber & strCSDVersion
If (Len(strCSDVersion)) Then
strCSDVersion = " (" & strCSDVersion & ")"
End If
End If
'*************************************************************************
End If
End With
End If
fOSName = strOut
End Function

'==================================================

Private Function fTrimNull(strIn As String) As String
Dim intPos As Integer
intPos = InStr(1, strIn, vbNullChar)
If intPos Then
fTrimNull = Mid$(strIn, 1, intPos - 1)
Else
fTrimNull = strIn
End If
End Function
' ********** Code End **********
'=========================


Thanks,
PC

 

[Douglas J. Steele]

What does "doesn't work" mean?

Do you get an error message? If so, what's the message? If you don't get an
error message, what symptom are you experiencing?

 

[PC User]

I also tried this on the On Open form event and there is no response.
Either way there is no error message or information displayed in the
unbound field intended to display the Windows Version. Is there
another way to use this function to try it?

Thanks,
PC

 

[Douglas J. Steele]

Open the immediate window (Ctrl-G), type

?fOSName

and hit Enter.

The response should be written right underneath:

?fOSName
Windows XP (Version 5.1) Build 2600 (Service Pack 2)

 

[PC User]

Ok Doug,
I deleted all the unused code for my project, since
the only two operating systems at our company is Windows XP and
Windows Vista. So now the code works in the immediate window. I
don't know what the problem with the portion of code that I removed,
but now the code below does work. Thanks Doug.

?fOSName
Windows Vista (Version 6.0) Build 6000

Code
'=========================
Option Compare Database

' ******** Code Start ********
'This code was originally written by Dev Ashish.
'It is not to be altered or distributed,
'except as part of an application.
'You are free to use it in any application,
'provided the copyright notice is left unchanged.
'
'Code Courtesy of
'Dev Ashish
'

Private Type OSVERSIONINFO
dwOSVersionInfoSize As Long
dwMajorVersion As Long
dwMinorVersion As Long
dwBuildNumber As Long
dwPlatformId As Long
szCSDVersion As String * 128
End Type

Private Declare Function apiGetVersionEx Lib "kernel32" _
Alias "GetVersionExA" _
(lpVersionInformation As Any) _
As Long

Private Const VER_PLATFORM_WIN32_WINDOWS = 1
Private Const VER_PLATFORM_WIN32_NT = 2



Function fOSName() As String
Dim osvi As OSVERSIONINFO
Dim strOut As String
Dim strCSDVersion As String

osvi.dwOSVersionInfoSize = Len(osvi)
If CBool(apiGetVersionEx(osvi)) Then
With osvi

strCSDVersion = fTrimNull(.szCSDVersion)
' XP
<*************************************************************
If .dwPlatformId = VER_PLATFORM_WIN32_NT And _
.dwMajorVersion = 5 And _
.dwMinorVersion = 1 Then
strOut = "Windows XP (Version " & _
.dwMajorVersion & "." & .dwMinorVersion & _
") Build " & .dwBuildNumber
If (Len(.szCSDVersion)) Then
strOut = strOut & " (" & _
fTrimNull(.szCSDVersion) & ")"
End If
End If
' Vista
<*************************************************************
If .dwPlatformId = VER_PLATFORM_WIN32_NT And _
.dwMajorVersion = 6 And _
.dwMinorVersion = 0 Then
strOut = "Windows Vista (Version " & _
.dwMajorVersion & "." & .dwMinorVersion & _
") Build " & .dwBuildNumber & strCSDVersion
If (Len(strCSDVersion)) Then
strCSDVersion = " (" & strCSDVersion & ")"
End If
End If

End With
End If
fOSName = strOut
End Function


Private Function fTrimNull(strIn As String) As String
Dim intPos As Integer
intPos = InStr(1, strIn, vbNullChar)
If intPos Then
fTrimNull = Mid$(strIn, 1, intPos - 1)
Else
fTrimNull = strIn
End If
End Function
' ********** Code End **********

 

[PC User]

My purpose in trying to detect the current OS is to change the links
to the reference libraries that differ between Access 2000 and Access
2007. When I think of it, maybe I should be detecting which version
of Access that I'm using instead of which OS? Is there a way to do
this and use the results for Access to programmically change
references?

Thanks,
PC

 

[Ron Hinds]

My purpose in trying to detect the current OS is to change the links
to the reference libraries that differ between Access 2000 and Access
2007. When I think of it, maybe I should be detecting which version
of Access that I'm using instead of which OS? Is there a way to do
this and use the results for Access to programmically change
references?

Thanks,
PC

Application.Version will return a string with the version number (e.g. 11.0
for Access 2003).

 

[Douglas J. Steele]

The OS shouldn't matter: usually it's only the version of Access that
matters unless you're using OS-dependent ActiveX controls.

But what references are you trying to change? It's seldom necessary (nor a
good idea). Use late binding as much as you can. If you are going to change
references, make sure you read what MichKa's got at
http://www.trigeminal.com/usenet/usenet026.asp

 

[PC User]

Doug,

I have Vista and Office 2007 on my computer and our temp worker
has XP and Office 2000 on his. We share the backend of a database,
but when ever I upgrade the programming in the database I give him a
copy. There are references the database uses that it has trouble
finding when I give him a copy of the database (in compatible mode)
that I've upgraded while using Office 2007. References that the
database seems to have trouble locating are as follows.
=======================================
Office 2000 references
Microsoft Excel 9.0 Object Library
Microsoft Common Dialog Control 6.0 (SP)
Microsoft Windows Common Control 6.0 (SP)


Office 2007 references
Microsoft Excel 12.0 Object Library
=======================================
Everytime I give him an upgrade, I have to reset the references.
Since I'm not a professional programmer, I'm developing the database
as I'm also being productive on my main projects. The database when
completed, is intended to automate a number of parts of my project and
will help to expedite reports that have previously involved manualling
filling in the forms made on MS Word documents. Switching between MS
Office versions and resetting the references is a bit of a nuisance
and I'd like to automate it. Hopefully, my company will upgrade the
remaining computers to Vista and Office 2007 and I won't have to do
this.

Thanks,
PC

 

[Tony Toews [MVP]]

Microsoft Excel 9.0 Object Library

Use late binding. Late binding means you can safely remove the
reference and only have an error when the app executes lines of code
in question. Rather than erroring out while starting up the app and
not allowing the users in the app at all. Or when hitting a mid, left
or trim function call.

You'll want to install the reference if you are programming or
debugging and want to use the object intellisense while in the VBA
editor. Then,. once your app is running smoothly, remove the
reference and setup the late binding statements.

Sample code:
' Declare an object variable to hold the object
' reference. Dim as Object causes late binding.
Dim objWordDoc As Object
Set objWordDoc = CreateObject(" Word.Document")

For more information including additional text and some detailed links
see the "Late Binding in Microsoft Access" page at
http://www.granite.ab.ca/access/latebinding.htm

Microsoft Common Dialog Control 6.0 (SP)
Microsoft Windows Common Control 6.0 (SP)

Use API calls for these.

How do you get rid of troublesome ActiveX Controls/references?
http://www.granite.ab.ca/access/referencetroubles.htm
Now these look like ugly code. However it's mostly a matter of
dropping in the wrapper API functions into a module and calling them.

Office 2007 references
Microsoft Excel 12.0 Object Library

Late binding again.

Tony
--
Tony Toews, Microsoft Access MVP
Please respond only in the newsgroups so that others can
read the entire thread of messages.
Microsoft Access Links, Hints, Tips & Accounting Systems at
http://www.granite.ab.ca/accsmstr.htm
Tony's Microsoft Access Blog - http://msmvps.com/blogs/access/

 

[PC User]

Thanks for the link. It will take some study on my part.

PC

 

[PC User]

Ok. I did find code to determine the version of MS Access, but again I
need help to detect Version 2007 and put the info into a textbox
instead of a word document. Here's the code. Can someone help me on
this?

Code
================================
Public Function OfficeDir(OffVer As String) As String
On Error GoTo ErrorTrap

Dim objWord As Object

Set objWord = CreateObject("Word.Application")

Select Case OffVer
Case "acc97"
OfficeDir = objWord.System.PrivateProfileString("", _
"HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Office\8.0", _
"BinDirPath") & "\msaccess.exe"
'Debug.Print OfficeDir
Case "acc2k"
OfficeDir = objWord.System.PrivateProfileString("", _
"HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Office\9.0\Access
\InstallRoot", _
"Path") & "msaccess.exe"
Debug.Print OfficeDir
Case "accxp"
OfficeDir = objWord.System.PrivateProfileString("", _
"HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Office\10.0\Access
\InstallRoot", _
"Path") & "msaccess.exe"
Debug.Print OfficeDir
Case Else
End Select

objWord.quit
Set objWord = Nothing

Exit Function
ErrorTrap:

objWord.Close
Set objWord = Nothing
MsgBox "Error " & Err & ". " & Err.Description & ".", vbCritical
Exit Function

End Function
================================

Thanks,
PC

 

[DABO]

c'est pas la peine de m'envoyer des message je répondrais bon aller bye bye
good bye a+a++++

"PC User" <[email protected]> a écrit dans le message de groupe de
discussion :
(e-mail address removed)...