[Resolvido]Qual é a versão Access?

Estou montando meu instalador e preciso detectar corretamente quando o usuário usa o Access 2016, quando usa o Access 2019, e também quando usa o Access 365. Como não tenho essas versões, podem testar e dizer se o instalador detecta corretamente sua versão?

Obs.: nada é instalado na máquina, apenas uma mensagem é exibida.

Agradeço

Olá Ivan, teste em duas máquinas:



Abraço

Uso o Office 365, deu "Access desconhecido"

Ivan

Uso Access 2013 32

Deu a informação certa




Também testei no Access Runtime e deu a mesma informação,

Só complementando meu senário: Windows 10 Pro X64 - Office 365 x32.

Obs:

Em casa tenho o mesmo cenário e em ambos os locais meu MSACCESS.exe ficam nesse caminho:
C:\Program Files (x86)\Microsoft Office\root\Office16

Boa tarde,

Tentei testar no pc do serviço e como não tenho permissão de administrador não deixou executar.

Se houvesse forma de contornar essa permissão ficava excelente.

Abraço

Senhores, antes de tudo agradeço pelo retorno. No momento estou no trabalho e assim que chegar em casa verifico meu código, reajusto e upo uma atualização do executável da primeira mensagem para testarmos. Dando certo, compartilharei o método usado com linhas comentadas.

pcnet, meus instaladores precisam de permissão de administrador pois quase sempre fazem instalações adicionais (exemplo: driver odbc mysql) ou atualizações mínimas necessárias (services packs) e usam o diretório C para instalação do aplicativo. Tentarei remover esse requisito de permissão já que é apenas para um teste aqui.

Voltei, senhores. Enfim encontrei o problema. Uma parte da estrutura do instalador tentar ler a chave abaixo para descobrir se o office é 32 ou 64 bits

Código:

HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Office\VersãoApplicationDoOffice\Outlook\Bitness

Parecia algo simples, mas o instalador não conseguia o fazer.

Muitos testes e descubro que para o instalador diversas chaves no registro sequer existiam. Refiz os métodos terceirizando o serviço para um .vbs e também para um .bat e mesmo assim não dava certo quando os executava durante a inicialização do instalador, tal qual acontecia comigo neste tópico.

Fui ler. Então descobri que o editor de registros do windows pode ser lido de dois modos (32 ou 64 bits) dependendo da ferramenta/programa. Bastou então adicionar a linha abaixo na seção setup do instalador para que assim o regedit pudesse ser lido de ambas as formas (tanto 32 como 64 bits)

Código:

ArchitecturesInstallIn64BitMode=x64

Não sei se isso acontece desde sempre pois estou me deparando com o problema só hoje quando tenho necessidade de fazer verificações na máquina do cliente para tomadas de decisões durante uma instalação automática.

Aguardo retorno dos senhores sobre o funcionamento do arquivo anexo a esta mensagem.

Aqui ainda continuou a dar Access desconhecido.
Mandei um print do meu Regedit para você ver como
é no meu senário.

Marcelo, grato. No seu registro, Quais valores existem nos caminhos abaixo?

Código:

HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows\CurrentVersion\App Paths\MSACCESS.EXE\Path
HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Office\15.0\Outlook\Bitness
HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Office\16.0\Outlook\Bitness

E como o office aparece em programas e recursos no seu painel de controle?

Exemplo:

HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows\CurrentVersion\App Paths\MSACCESS.EXE\Path

Print da chave acima na imagem 1.

Essas 2 chaves são diferentes qui, elas:
HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Office\15.0\Outlook\Bitness
HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Office\16.0\Outlook\Bitness

Elas não tem o Outlook\Bitness, são assim:
HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Office\15.0
HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Office\16.0

O Outlook\Bitness está abaixo das duas, assim:
HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Office\15.0
HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Office\16.0
..aqui tem outras que não vem ao caso...
HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Office\Outlook

E mesmo assim não tem dentro de Outlook a pasta: Bitness.

Veja nas imagens.

Ok, então. O office 365 não usa essa parte do registro. Farei este tratamento no código e retorno aqui. Creio que o office 2019 já seja detectado pelo instalador.

Olá a todos,

Ivan, com o novo teste obtive o mesmo resultado da mensagem nº 2.
Estive e pesquisar um pouco, verifiquem com teste script:

Código:

Option Explicit
'ahteixeira 2019 para MaximoAccess
Dim oShell
Dim sTemp
Set oShell = CreateObject("WScript.Shell")
On Error Resume Next
sTemp = oShell.RegRead("HKCR\Access.Application\CurVer\")
If Len(sTemp & "") > 2 Then sTemp= Replace(Right(sTemp, 2), ".", "")
MsgBox sTemp

Não tenho nenhuma máquina que não tenha o "office" instalado para testar.
Mas em todas as que testei funcionou, veja se por aqui consegue resolver.

Outra coisa, testei no Access 2016 e 2019 e em ambas apresenta 16
Quem poder testar o script e partilhar o resultado será otimo.

Abraço a todos

Exatamente, mestre Alvaro. Do Access 2016 em diante o resultado para consultas sobre a versão do aplicativo (application.version) será sempre 16.0. A questão agora e detectar quando é o office 2016, 2019 e 365.

Ontem adaptei o código e consegui detectar quando se tratava do office 2019. Pelas imagens do Marcelo vejo que o office 365 trabalha um pouco diferente com as chaves no registro.

Farei uma versão com msgbox de cada etapa executada para que possam acompanhar o que o instalador verifica.

Olá Ivan,

Ainda existe pouca informação sobre o tema.
Eu creio que o Office 365 com licença para Ms-Access o que faz é disponibilizar a última versão "tradicional" do Access.
No artigo abixo, podemos verificar que é a versão 16.
support.office.com/pt-br/article/access-incluído-como-parte-do-office-365-business-e-business-premium-f55c8362-5816-4f8b-897d-0a05e7ba0fef

O que não compreendo é a versão 2019 ser a mesma que o 2016, ou seja 16.

Estamos a desvendar.

Eis o roteiro que o instalador faz (em vbscript). Alvaro, veja se detecta sua versão 2019.

Código:

option explicit

const HKLM = &H80000002
const SEMERRO = 0

dim objEdReg
dim strVerAcc

Set objEdReg = GetObject("winmgmts:{impersonationLevel=impersonate}!\\.\root\default:StdRegProv")

if objEdReg.GetStringValue(HKLM, "Software\Microsoft\Windows\CurrentVersion\App Paths\msaccess.exe", "Path", strVerAcc) <> SEMERRO then
   call msgbox("Nenhuma versão Access detectada.", vbinformation,"Ops...")
else

   strVerAcc = right(strVerAcc, 3)
   strVerAcc = left(strVerAcc, 2)

   select case strVerAcc

      case "12"
         call msgbox("Access 2007 " & Bits(), vbinformation, "Informação")

      case "14"
         call msgbox("Access 2010 " & Bits(), vbinformation, "Informação")

      case "15"
         call msgbox("Access 2013 " & Bits(), vbinformation, "Informação")

      case "16"
         call fncTrabalhaVersao16

      case else
         call msgbox("Você é de outro mundo por está muito atualizado ou muito desatualizado.", vbexclamation, "Alienígena")

   end select

end if

set objEdReg = nothing

sub fncTrabalhaVersao16()

   dim strKeyPath
   dim arrSubKeys
   dim subkey
   dim strVerOffice

   if win64 and Bits() = "32 bits" then
      strKeyPath = "Software\Wow6432Node\Microsoft\Windows\CurrentVersion\Uninstall"
   else
      strKeyPath = "Software\Microsoft\Windows\CurrentVersion\Uninstall"
   end if

   call objEdReg.EnumKey(HKLM, strKeyPath, arrSubKeys)

   for each subkey in arrSubKeys

      if left(subkey, 1) <> "{" Then

         call objEdReg.GetStringValue(HKLM, strKeyPath & "\" & subkey, "DisplayName", strVerOffice)
            
         if instr(strVerOffice, "Microsoft Office") then
            if instr(strVerOffice, "2016") then
               call msgbox("Access 2016 " & Bits(), vbinformation, "Informação")
               exit sub
            elseif instr(strVerOffice, "2019") then
               call msgbox("Access 2019 " & Bits(), vbinformation, "Informação")
               exit sub
            elseif instr(strVerOffice, "365") then
               call msgbox("Access 365 " & Bits(), vbinformation, "Informação")
               exit sub
            end if
         end if

      end if

   next

   call msgbox("Access desconhecido.", vbexclamation, "Ops...")

end sub

function win64()

   dim objWMIService
   dim colOperatingSystems
   dim objOperatingSystem

   set objWMIService = getObject("winmgmts:\\.\root\cimv2")
   set colOperatingSystems = objWMIService.ExecQuery("Select * from Win32_OperatingSystem")

   for each objOperatingSystem in colOperatingSystems
      win64 = instr(objOperatingSystem.OSArchitecture,"64") > 0
   next

end function

function Bits()

   dim strBits

   if win64 then
      if objEdReg.GetStringValue(HKLM, "Software\Microsoft\Office\" & strVerAcc & ".0\Outlook", "Bitness", strBits) = SEMERRO then
         if strBits = "x64" then
            Bits = "64 bits"
         else
            Bits = "32 bits"
         end if
      else
         Bits = "32 bits"
      end if
   else
      Bits = "32 bits"
   end if

end function

Olá Ivan, a mesma situação da mensagem nº 2.

E como podemos verificar na imagem o 2019 ainda é a versão 16.
Parece que no 365 também é, veja:
tomtalks.blog/2016/01/choose-office-2016-branch-local-group-policy/

Este artigo apesar de ser para o 2010 descreve bem as entradas de registo do Office:
support.microsoft.com/en-us/help/2186281/description-of-the-numbering-scheme-for-product-code-guids-in-office-2

Também se levanta outra questão no script, pois pode ter o Office instalado sem o Access.
Veja melhor o meu ultimo exemplo e solicito aos colegas para testar numa máquina com Office sem o Access instalado.

Abraço a todos

Mestre Marcelo, mestre Alvaro e demais usuários, pelas situações ocorridas, imagens anexadas, artigos aqui indicados, e tendo agora instalado uma versão ClickToRun (assim como vocês), creio ter montado o script correto.

Código:

option explicit

const HKLM = &H80000002
const SEMERRO = 0

dim objEdReg
dim strVerAcc
dim booClickToRun

Set objEdReg = GetObject("winmgmts:{impersonationLevel=impersonate}!\\.\root\default:StdRegProv")

if objEdReg.GetStringValue(HKLM, "Software\Microsoft\Windows\CurrentVersion\App Paths\msaccess.exe", "Path", strVerAcc) <> SEMERRO then
  call msgbox("Nenhuma versão Access detectada.", vbinformation,"Ops...")
else

  strVerAcc = right(strVerAcc, 3)
  strVerAcc = left(strVerAcc, 2)

  select case strVerAcc

      case "12"
        call msgbox("Access 2007 " & Bits(), vbinformation, "Informação")

      case "14"
        call msgbox("Access 2010 " & Bits(), vbinformation, "Informação")

      case "15"
        call msgbox("Access 2013 " & Bits(), vbinformation, "Informação")

      case "16"
        call fncTrabalhaVersao16

      case else
        call msgbox("Você é de outro mundo por está muito atualizado ou muito desatualizado.", vbexclamation, "Alienígena")

  end select

end if

set objEdReg = nothing

sub fncTrabalhaVersao16()

  dim strKeyPath
  dim arrSubKeys
  dim subkey
  dim strVerOffice

  booClickToRun = false

  if win64 then
      if Bits() = "32 bits" then
        if not booClickToRun then
            strKeyPath = "Software\Wow6432Node\Microsoft\Windows\CurrentVersion\Uninstall"
        else
            strKeyPath = "Software\Microsoft\Windows\CurrentVersion\Uninstall"
        end if
      else
        strKeyPath = "Software\Microsoft\Windows\CurrentVersion\Uninstall"
      end if
  else
      strKeyPath = "Software\Microsoft\Windows\CurrentVersion\Uninstall"
  end if

  call objEdReg.EnumKey(HKLM, strKeyPath, arrSubKeys)

  for each subkey in arrSubKeys

      if left(subkey, 1) <> "{" Then

        call objEdReg.GetStringValue(HKLM, strKeyPath & "\" & subkey, "DisplayName", strVerOffice)
           
        if instr(strVerOffice, "Microsoft Office") or instr(strVerOffice, "Microsoft Access") or instr(strVerOffice, "Microsoft 365") then
            if instr(strVerOffice, "2016") and left(subkey, 9)="Office16." then
              call msgbox("Access 2016 " & Bits(), vbinformation, "Informação")
              exit sub
            elseif instr(strVerOffice, "2019") then
              call msgbox("Access 2019 " & Bits(), vbinformation, "Informação")
              exit sub
       elseif instr(strVerOffice, "2021") then
              call msgbox("Access 2021 " & Bits(), vbinformation, "Informação")
              exit sub
            elseif instr(strVerOffice, "365") or (instr(strVerOffice, "2016") and left(subkey, 9)<>"Office16.") then
              call msgbox("Access 365 " & Bits(), vbinformation, "Informação")
              exit sub
            end if
        end if

      end if

  next

  call msgbox("Access desconhecido.", vbexclamation, "Ops...")

end sub

function win64()

  dim objWMIService
  dim colOperatingSystems
  dim objOperatingSystem

  set objWMIService = getObject("winmgmts:\\.\root\cimv2")
  set colOperatingSystems = objWMIService.ExecQuery("Select * from Win32_OperatingSystem")

  for each objOperatingSystem in colOperatingSystems
      win64 = instr(objOperatingSystem.OSArchitecture,"64") > 0
  next

end function

function Bits()

  dim strBits

  strBits = ""

  if not win64 then
      Bits = "32 bits"
      exit function
  end if

  if objEdReg.GetStringValue(HKLM, "Software\Microsoft\Office\" & strVerAcc & ".0\Outlook", "Bitness", strBits) <> SEMERRO then
      if objEdReg.GetStringValue(HKLM, "Software\Microsoft\Office\ClickToRun\Configuration", "Platform", strBits) = SEMERRO then
        booClickToRun = true
      else
        Bits = "32 bits"
        exit function
      end if
  end if

  if strBits = "x64" then
      Bits = "64 bits"
  else
      Bits = "32 bits"
  end if

end function

Olá a todos,

Ivan, agora funcionou no Access 2019 32 Bits e também no 2016 32 Bits também.
Foi nos que tenho oportunidade de testar.

Abraço

Obrigado pelo retorno, mestre Alvaro. Vale-me muito.

Veremos como o código se sairá com office 365.

Boa tarde mestre Ivan,

Tentei testar no meu pc pessoal com o Windows 8.1 instalado, mas não tive sucesso.
Apareceu este erro:



Testei com outro exemplo partilhado pelo mestre Álvaro Teixeira e apresentou a versão instalada.


Abraço

Ok, pcnet... esse problema vai ser algo mais específico da linguagem vbscrip com o win8.1

Havia deixado nessa linguagem pra que pudessem ver como as verificações são feitas.

Tenta no instalador real em formato .exe

Aguardo...

Boa noite mestre Ivan,

Testado com êxito

Eis o teste:


Abraço

Valeu, meu nobre. Obrigado pelo retorno.

Windows 10 x64 - Office 365 x32. Deu certo aqui!!

Boa noite, funcionou na perfeição!!

Agradeço por me ajudarem testando e dando os retornos.

Tudo resolvido então.

Resumo disto, aqui
https://www.maximoaccess.com/t36343-access-x-inno-setup-x-editor-de-registro

Enriquecendo o tópico
mendipdatasystems.co.uk/access-office365-win-check/4594488974

Olá Ivan,

Obrigado pela dica, o fórum agradece.

Abraço

Olá a todos,

Ivan, Passeio por um computador com o Office Casa e Negócios (que não tem Access), por essa razão é que tem o Runtime do 2003 e testei com a última versão disponibilizada:


Com o script da mensagem nº 13 apresenta que tem a versão 11.

Abraço

Obrigado por informar, meste Alvaro.

Mensagem personalizada nos conformes do código da mensagem nº 18 rsrsrs

script da mensagem nº 18 atualizado.

Boas...aqui funfou !!!

Opa, valeu por testar, meu nobre.

Testei, funcionou.

Abraços

Olá Ivan,

Em todos que testei ok, menos no meu portatil que tem as ultimas versoes, veja


Abraço

Mestre Alvaro, pela mensagem, o código está detectando seu Access 2003. Só fiz mensagem personalizada do 2007 e superiores.

Mas fiquei curioso sobre a versão portatil.

Olá Ivan,

Como pode ver na imagem, em Março fiz atualização do meu portatil para Windows 11 e optei por fazer o download da ultima versão o Office Professional Plus 2021.
No entanto é verdade tenho o 2003 instalado juntamente com a versão que referi.
Desde a versao 2016 que costumo fazer a instalação de ambas (2003 32 bit e 2016 64 bits) e não tenho tido problemas.

Abraço

Olá Ivan,

Hoje tive um tempinho e atualizei de codigo a detetar o 2003 e o 2021, já testei no 2021 e funciona, veja:


Ficou assim o código do meu teste

Código:

option explicit
'update 22-04-2022
const HKLM = &H80000002
const SEMERRO = 0

dim objEdReg
dim strVerAcc
dim booClickToRun

Set objEdReg = GetObject("winmgmts:{impersonationLevel=impersonate}!\\.\root\default:StdRegProv")

if objEdReg.GetStringValue(HKLM, "Software\Microsoft\Windows\CurrentVersion\App Paths\msaccess.exe", "Path", strVerAcc) <> SEMERRO then
  call msgbox("Nenhuma versão Access detectada.", vbinformation,"Ops...")
else

  strVerAcc = right(strVerAcc, 3)
  strVerAcc = left(strVerAcc, 2)

  select case strVerAcc

      Case "11"
        Call MsgBox("Access 2003 32 bits", vbInformation, "Informação")
      
      case "12"
        call msgbox("Access 2007 " & Bits(), vbinformation, "Informação")

      case "14"
        call msgbox("Access 2010 " & Bits(), vbinformation, "Informação")

      case "15"
        call msgbox("Access 2013 " & Bits(), vbinformation, "Informação")

      case "16"
        call fncTrabalhaVersao16

      case else
        call msgbox("Você é de outro mundo por está muito atualizado ou muito desatualizado.", vbexclamation, "Alienígena")

  end select

end if

set objEdReg = nothing

sub fncTrabalhaVersao16()

  dim strKeyPath
  dim arrSubKeys
  dim subkey
  dim strVerOffice

  booClickToRun = false

  if win64 then
      if Bits() = "32 bits" then
        if not booClickToRun then
            strKeyPath = "Software\Wow6432Node\Microsoft\Windows\CurrentVersion\Uninstall"
        else
            strKeyPath = "Software\Microsoft\Windows\CurrentVersion\Uninstall"
        end if
      else
        strKeyPath = "Software\Microsoft\Windows\CurrentVersion\Uninstall"
      end if
  else
      strKeyPath = "Software\Microsoft\Windows\CurrentVersion\Uninstall"
  end if

  call objEdReg.EnumKey(HKLM, strKeyPath, arrSubKeys)

  for each subkey in arrSubKeys

      if left(subkey, 1) <> "{" Then

        call objEdReg.GetStringValue(HKLM, strKeyPath & "\" & subkey, "DisplayName", strVerOffice)

        if instr(strVerOffice, "Microsoft Office") or instr(strVerOffice, "Microsoft Access") then

            if instr(strVerOffice, "2016") then
              call msgbox("Access 2016 " & Bits(), vbinformation, "Informação")
              exit sub
            elseif instr(strVerOffice, "2019") then
              call msgbox("Access 2019 " & Bits(), vbinformation, "Informação")
              exit sub
            elseif instr(strVerOffice, "2021") then
              call msgbox("Access 2021 " & Bits(), vbinformation, "Informação")
              exit sub
            elseif instr(strVerOffice, "365") then
              call msgbox("Access 365 " & Bits(), vbinformation, "Informação")
              exit sub
            end if
        end if

      end if

  next

  call msgbox("Access desconhecido.", vbexclamation, "Ops...")

end sub

function win64()

  dim objWMIService
  dim colOperatingSystems
  dim objOperatingSystem

  set objWMIService = getObject("winmgmts:\\.\root\cimv2")
  set colOperatingSystems = objWMIService.ExecQuery("Select * from Win32_OperatingSystem")

  for each objOperatingSystem in colOperatingSystems
      win64 = instr(objOperatingSystem.OSArchitecture,"64") > 0
  next

end function

function Bits()

  dim strBits

  strBits = ""

  if not win64 then
      Bits = "32 bits"
      exit function
  end if

  if objEdReg.GetStringValue(HKLM, "Software\Microsoft\Office\" & strVerAcc & ".0\Outlook", "Bitness", strBits) <> SEMERRO then
      if objEdReg.GetStringValue(HKLM, "Software\Microsoft\Office\ClickToRun\Configuration", "Platform", strBits) = SEMERRO then
        booClickToRun = true
      else
        Bits = "32 bits"
        exit function
      end if
  end if

  if strBits = "x64" then
      Bits = "64 bits"
  else
      Bits = "32 bits"
  end if

end function

Nota, no portátil, que tem as duas versões estaladas deteta a versão 2003, assim que disponha de algum tempo vou tentar ver se consigo fazer mostrar as versoes instaladas.
Aproveito para deixar link de outro metodo que vai verificar no licenciamento
excelguru.ca/blog/2019/02/11/check-the-application-version-in-modern-office/

Abraço

Boa noite,

Estou precisando de uma ajuda por favor,

Estou tentando utilizar esta solução dentro do meu aplicativo, baixei o script, testei e funcionou legal identificando as informações corretamente, ai transcrevi para um módulo padrão dentro do Ms Access 2019 32 Bits que utilizo, pois estou querendo que quando o usuario executar o access eu consiga saber qual a versão do S.O. e qual a do Access, mas ele retorna a mensagem : Ops... Access não Reconhecido. mas ele já identificou  no script e não mudei praticamente nada.

Eu fui verificando passo a passo e notei que ele sempre verifica a entrada de registro Wow6432Node independente de mim alterar para teste  a Const HKLM = &H80000002

If Not booClickToRun Then
           strKeyPath = "Software\Wow6432Node\Microsoft\Windows\CurrentVersion\Uninstall"
        Else
           strKeyPath = "SOFTWARE\Microsoft\Windows\CurrentVersion\Uninstall"
End If

Código:



Option Explicit


Const HKLM = &H80000002
Const SEMERRO = 0

Public objEdReg
Public strVerAcc
Public booClickToRun

Public Sub teste()


Set objEdReg = GetObject("winmgmts:{impersonationLevel=impersonate}!\\.\root\default:StdRegProv")

If objEdReg.GetStringValue(HKLM, "Software\Microsoft\Windows\CurrentVersion\App Paths\msaccess.exe", "Path", strVerAcc) <> SEMERRO Then
   Call MsgBox("Nenhuma versão Access detectada.", vbInformation, "Ops...")
Else

   strVerAcc = Right(strVerAcc, 3)
   strVerAcc = Left(strVerAcc, 2)

   Select Case strVerAcc

      Case "12"
         Call MsgBox("Access 2007 " & Bits(), vbInformation, "Informação")

      Case "14"
         Call MsgBox("Access 2010 " & Bits(), vbInformation, "Informação")

      Case "15"
         Call MsgBox("Access 2013 " & Bits(), vbInformation, "Informação")

      Case "16"
         Call fncTrabalhaVersao16

      Case Else
         Call MsgBox("Você é de outro mundo por está muito atualizado ou muito desatualizado.", vbExclamation, "Alienígena")

   End Select

End If

Set objEdReg = Nothing

End Sub

Sub fncTrabalhaVersao16()

   Dim strKeyPath
   Dim arrSubKeys
   Dim subkey
   Dim strVerOffice

   booClickToRun = False

   If win64 Then
      If Bits() = "32 bits" Then
         If Not booClickToRun Then
            strKeyPath = "Software\Wow6432Node\Microsoft\Windows\CurrentVersion\Uninstall"
         Else
            strKeyPath = "SOFTWARE\Microsoft\Windows\CurrentVersion\Uninstall"
         End If
      Else
         strKeyPath = "Software\Microsoft\Windows\CurrentVersion\Uninstall"
      End If
   Else
      strKeyPath = "Software\Microsoft\Windows\CurrentVersion\Uninstall"
   End If

   Call objEdReg.EnumKey(HKLM, strKeyPath, arrSubKeys)

   For Each subkey In arrSubKeys

      If Left(subkey, 1) <> "{" Then

         Call objEdReg.GetStringValue(&H80000002, strKeyPath & "\" & subkey, "DisplayName", strVerOffice)
            
         If InStr(strVerOffice, "Microsoft Office") Or InStr(strVerOffice, "Microsoft Access") Then
            If InStr(strVerOffice, "2016") Then
               Call MsgBox("Access 2016 " & Bits(), vbInformation, "Informação")
               Exit Sub
            ElseIf InStr(strVerOffice, "2019") Then
               Call MsgBox("Access 2019 " & Bits(), vbInformation, "Informação")
               Exit Sub
            ElseIf InStr(strVerOffice, "365") Then
               Call MsgBox("Access 365 " & Bits(), vbInformation, "Informação")
               Exit Sub
            End If
         End If

      End If

   Next

   Call MsgBox("Access desconhecido.", vbExclamation, "Ops...")

End Sub

Function win64()

   Dim objWMIService
   Dim colOperatingSystems
   Dim objOperatingSystem

   Set objWMIService = GetObject("winmgmts:\\.\root\cimv2")
   Set colOperatingSystems = objWMIService.ExecQuery("Select * from Win32_OperatingSystem")

   For Each objOperatingSystem In colOperatingSystems
      win64 = InStr(objOperatingSystem.OSArchitecture, "64") > 0
   Next

End Function

Function Bits()

   Dim strBits

   strBits = ""

   If Not win64 Then
      Bits = "32 bits"
      Exit Function
   End If

   If objEdReg.GetStringValue(HKLM, "Software\Microsoft\Office\" & strVerAcc & ".0\Outlook", "Bitness", strBits) <> SEMERRO Then
      If objEdReg.GetStringValue(HKLM, "Software\Microsoft\Office\ClickToRun\Configuration", "Platform", strBits) = SEMERRO Then
         booClickToRun = True
      Else
         Bits = "32 bits"
         Exit Function
      End If
   End If

   If strBits = "x64" Then
      Bits = "64 bits"
   Else
      Bits = "32 bits"
   End If

End Function




Obrigado

Olá André Santos,

Testei no 2019 a 32 Bits e funcionou, veja:



Entretanto fiz uma atualização, pois não estava a mostrar o Microsoft 365 Apps for business, veja:


Como podemos verificar este scritp está a ir buscar ao informação "aos programas instalados".
Segue o ficheiro e código atualizado:

Código:

option explicit
'Updated 19-10-2023 by Alvaro Teixeira to MaximoAccess.com
const HKLM = &H80000002
const SEMERRO = 0

dim objEdReg
dim strVerAcc
dim booClickToRun

Set objEdReg = GetObject("winmgmts:{impersonationLevel=impersonate}!\\.\root\default:StdRegProv")

if objEdReg.GetStringValue(HKLM, "Software\Microsoft\Windows\CurrentVersion\App Paths\msaccess.exe", "Path", strVerAcc) <> SEMERRO then
  call msgbox("Nenhuma versão Access detectada.", vbinformation,"Ops...")
else

  strVerAcc = right(strVerAcc, 3)
  strVerAcc = left(strVerAcc, 2)

  select case strVerAcc

      Case "11"
        Call MsgBox("Access 2003 32 bits", vbInformation, "Informação")
     
      case "12"
        call msgbox("Access 2007 " & Bits(), vbinformation, "Informação")

      case "14"
        call msgbox("Access 2010 " & Bits(), vbinformation, "Informação")

      case "15"
        call msgbox("Access 2013 " & Bits(), vbinformation, "Informação")

      case "16"
        call fncTrabalhaVersao16

      case else
        call msgbox("Você é de outro mundo por está muito atualizado ou muito desatualizado.", vbexclamation, "Alienígena")

  end select

end if

set objEdReg = nothing

sub fncTrabalhaVersao16()

  dim strKeyPath
  dim arrSubKeys
  dim subkey
  dim strVerOffice

  booClickToRun = false

  if win64 then
      if Bits() = "32 bits" then
        if not booClickToRun then
            strKeyPath = "Software\Wow6432Node\Microsoft\Windows\CurrentVersion\Uninstall"
        else
            strKeyPath = "Software\Microsoft\Windows\CurrentVersion\Uninstall"
        end if
      else
        strKeyPath = "Software\Microsoft\Windows\CurrentVersion\Uninstall"
      end if
  else
      strKeyPath = "Software\Microsoft\Windows\CurrentVersion\Uninstall"
  end if

  call objEdReg.EnumKey(HKLM, strKeyPath, arrSubKeys)

  for each subkey in arrSubKeys

      if left(subkey, 1) <> "{" Then

        call objEdReg.GetStringValue(HKLM, strKeyPath & "\" & subkey, "DisplayName", strVerOffice)

        if instr(strVerOffice, "Microsoft Office") or instr(strVerOffice, "Microsoft Access") or instr(strVerOffice, "Microsoft 365") then

            if instr(strVerOffice, "2016") then
              call msgbox("Access 2016 " & Bits(), vbinformation, "Informação")
              exit sub
            elseif instr(strVerOffice, "2019") then
              call msgbox("Access 2019 " & Bits(), vbinformation, "Informação")
              exit sub
            elseif instr(strVerOffice, "2021") then
              call msgbox("Access 2021 " & Bits(), vbinformation, "Informação")
              exit sub
            elseif instr(strVerOffice, "365") then
              call msgbox("Access 365 " & Bits(), vbinformation, "Informação")
              exit sub
            end if
        end if

      end if

  next
call msgbox(strVerOffice &"1", vbinformation, "Informação")
  call msgbox("Access desconhecido.", vbexclamation, "Ops...")

end sub

function win64()

  dim objWMIService
  dim colOperatingSystems
  dim objOperatingSystem

  set objWMIService = getObject("winmgmts:\\.\root\cimv2")
  set colOperatingSystems = objWMIService.ExecQuery("Select * from Win32_OperatingSystem")

  for each objOperatingSystem in colOperatingSystems
      win64 = instr(objOperatingSystem.OSArchitecture,"64") > 0
  next

end function

function Bits()

  dim strBits

  strBits = ""

  if not win64 then
      Bits = "32 bits"
      exit function
  end if

  if objEdReg.GetStringValue(HKLM, "Software\Microsoft\Office\" & strVerAcc & ".0\Outlook", "Bitness", strBits) <> SEMERRO then
      if objEdReg.GetStringValue(HKLM, "Software\Microsoft\Office\ClickToRun\Configuration", "Platform", strBits) = SEMERRO then
        booClickToRun = true
      else
        Bits = "32 bits"
        exit function
      end if
  end if

  if strBits = "x64" then
      Bits = "64 bits"
  else
      Bits = "32 bits"
  end if

end function



Abraço a todos

Obrigado pela atenção mas você executou de dentro de um módulo dentro de um arquivo do Access ou foi por um arquivo vbs ou exe?

Olá André Santos,
Antes de tudo seja Bem-Vindo ao fórum (só agora é que vi que é membro novo).

Neste caso é VBS , devemos executar com duplo click num ficheiro com extensão .vbs

Abraço

Obrigado pela ajuda,

Consegui o que precisava, alterei o script para que ele :
1-Dentro do Access criei um módulo e executei o script alterado;
2-Limpo a área de transferência do Windows
3-Cole o resultado do script na área de transferência
4-Novamente no MS Access obtenho o dado na área de transferência e verifico o que preciso baseando-se no que foi obtido da área de transferência .

Obrigado

Olá André Santos,

Fico feliz por ter conseguido resolver.
Se desejar, pode partilhar o código adaptado, o fórum agradece.

Abraço

Vou sim, em breve posto, no momento estou em viagem