Thanks,
PC
.dwMajorVersion = 5 And _
.dwMinorVersion = 2 Then
(I think the code from "The Access Web" identifies it as ""Windows .NET
Server ")
--
Doug Steele, Microsoft Access MVP
http://I.Am/DougSteele
(no e-mails, please!)
"PC User" <pc_...@softhome.net> wrote in message
news:99788a82-963e-4a1f...@a35g2000prf.googlegroups.com...
.dwMajorVersion = 6 And _
.dwMinorVersion = 0 Then
"Douglas J. Steele" <NOSPAM_djsteele@NOSPAM_canada.com> wrote in message
news:uRKMkbTM...@TK2MSFTNGP04.phx.gbl...
Thanks for the assist. (Sorry for the misinformation, PC User!)
--
Doug Steele, Microsoft Access MVP
http://I.Am/DougSteele
(no private e-mails, please)
"Ron Hinds" <bi...@microsoft.com> wrote in message
news:%23i8Qt%23UMIH...@TK2MSFTNGP04.phx.gbl...
Thanks,
PC
--
Doug Steele, Microsoft Access MVP
http://I.Am/DougSteele
(no e-mails, please!)
"PC User" <pc_...@softhome.net> wrote in message
news:2e31f29e-8165-49c2...@e25g2000prg.googlegroups.com...
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.
--
Dirk Goldgar, MS Access MVP
www.datagnostics.com
(please reply to the newsgroup)
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
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?
--
Doug Steele, Microsoft Access MVP
http://I.Am/DougSteele
(no private e-mails, please)
"PC User" <pc_...@softhome.net> wrote in message
news:b5805db6-391c-4b2a...@i29g2000prf.googlegroups.com...
Thanks,
PC
?fOSName
and hit Enter.
The response should be written right underneath:
?fOSName
Windows XP (Version 5.1) Build 2600 (Service Pack 2)
--
Doug Steele, Microsoft Access MVP
http://I.Am/DougSteele
(no e-mails, please!)
"PC User" <pc_...@softhome.net> wrote in message
news:3fb288f2-01a8-4fc1...@s12g2000prg.googlegroups.com...
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
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
Thanks,
PC
Application.Version will return a string with the version number (e.g. 11.0
for Access 2003).
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
--
Doug Steele, Microsoft Access MVP
http://I.Am/DougSteele
(no e-mails, please!)
"PC User" <pc_...@softhome.net> wrote in message
news:28e3047e-b869-484b...@d21g2000prf.googlegroups.com...
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
>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
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
"PC User" <pc_...@softhome.net> a écrit dans le message de groupe de
discussion :
b224877a-0b04-4a9e...@s12g2000prg.googlegroups.com...
Select Case objRetVal
Case "8.0"
AccessVersion = "97"
Case "9.0"
AccessVersion = "2000"
Case "10.0"
AccessVersion = "2002"
Case "11.0"
AccessVersion = "2003"
Case "12.0"
AccessVersion = "2007"
End Select
Set objAccess = Nothing
End Function
=====================================