win7とwin10でマクロ動作が異なる

質問

ノートパソコンで動作するマクロがディスクトップパソコンで動作しません。
excelマクロはoffice2010(32bit版)で、どちらも同じ。

ディスクトップパソコン：win10(64ビットオペレーティングシステム)
ノートパソコン：wwin7(32ビットオペレーティングシステム)
です。

動作させたマクロは、webに掲載されていたものを参考にＡ列へ名称記載を追加したものです。

Sub get_application()

'インストールされているアプリケーション一覧を取得するVBAマクロ

Dim reg As Object
Dim keys As Variant
Dim key As Variant
Dim ret As Long
Dim display_name As String
Const HKEY_LOCAL_MACHINE = &H80000002
Const SubKeyName = "Software\Microsoft\Windows\CurrentVersion\Uninstall\"

Set reg = CreateObject("WbemScripting.SWbemLocator") _
.ConnectServer(, "root\default").Get("StdRegProv")
reg.EnumKey HKEY_LOCAL_MACHINE, SubKeyName, keys
On Error Resume Next

i = 1

For Each key In keys
display_name = ""
ret = reg.GetStringValue(HKEY_LOCAL_MACHINE, SubKeyName & key, "DisplayName", display_name)

If (ret = 0) And (Len(Trim(display_name)) > 0) Then ret = reg.GetStringValue(HKEY_LOCAL_MACHINE, SubKeyName & key, "QuietDisplayName", display_name)

If Len(Trim(display_name)) > 0 Then

Debug.Print display_name

Cells(i, 1) = display_name

i = i + 1

End If
Next
On Error GoTo 0

End Sub

win7だと上記マクロで動作するのですが、win10だとエラーがでるわけでもなく、だんまり状態となります。

If (ret = 0) And (Len(Trim(display_name)) > 0) Then ret = reg.GetStringValue(HKEY_LOCAL_MACHINE, SubKeyName & key, "QuietDisplayName", display_name)
の部分を削除すると、win7,win10共に動作します。
win7では、上記削除した部分の有無でマクロの実行結果は同じです。

なので、とりあえず、マクロ動作に関しては、不要で解決できているのですが、
何故win7で動作するマクロが、win10では、だんまりになるのか、
また、どういった処理なのかを、解説お願いできますでしょうか？

回答No.1

f272 · ベストアンサー

もし
https://www.ka-net.org/blog/?p=4878
を参考にしているのであれば
If (ret = 0) And (Len(Trim(display_name)) > 0) Then ret = ...
のところは
If ret <> 0 Then ret = ...
となっていますが，どうして変更したのでしょう？

win10では
ret = reg.GetStringValue(HKEY_LOCAL_MACHINE, SubKeyName & key, "DisplayName", display_name)
でdisplay_nameに値がちゃんと入って，ret=0の正常終了コードが帰り，その後に
If (ret = 0) And (Len(Trim(display_name)) > 0) Then ret = reg.GetStringValue(HKEY_LOCAL_MACHINE, SubKeyName & key, "QuietDisplayName", display_name)
でdisplay_name=""となって値が入らず，ret=1の異常終了コードが帰ってきます。そうするとIf Len(Trim(display_name)) > 0 Thenの中には入らずに，何も書かないということになってしまいます。

ret = reg.GetStringValue(HKEY_LOCAL_MACHINE, SubKeyName & key, "QuietDisplayName", display_name)
は
ret = reg.GetStringValue(HKEY_LOCAL_MACHINE, SubKeyName & key, "DisplayName", display_name)
が異常終了したときだけ実行すればよいのでIf ret <> 0 Thenとなるはずです。

お礼

回答ありがとうございます。

補足

If ret <> 0 Then ret = ...
となっていますが，どうして変更したのでしょう？
→
https://www.ka-net.org/blog/?p=4878
まで調べていただき、お手数おかけしました。

上記のwebでは
Option Explicit

Public Sub ListInstalledApplication()
Dim reg As Object
Dim keys As Variant
Dim key As Variant
Dim ret As Long
Dim display_name As String
Const HKEY_LOCAL_MACHINE = &H80000002
Const SubKeyName = "Software\Microsoft\Windows\CurrentVersion\Uninstall\"

Set reg = CreateObject("WbemScripting.SWbemLocator") _
.ConnectServer(, "root\default").Get("StdRegProv")
reg.EnumKey HKEY_LOCAL_MACHINE, SubKeyName, keys
On Error Resume Next
For Each key In keys
display_name = ""
ret = reg.GetStringValue(HKEY_LOCAL_MACHINE, SubKeyName & key, "DisplayName", display_name)
If ret <> 0 Then ret = reg.GetStringValue(HKEY_LOCAL_MACHINE, SubKeyName & key, "QuietDisplayName", display_name)
If (ret = 0) And (Len(Trim(display_name)) > 0) Then
Debug.Print display_name
End If
Next
On Error GoTo 0
End Sub
となっています。

ret = reg.GetStringValue(HKEY_LOCAL_MACHINE, SubKeyName & key, "DisplayName", display_name)
が異常終了したときだけ実行
というのが分からなかったです。

２つめのif文で、
Debug.Print display_name
display_nameを表示する条件にret=0のAND条件となっていたので、
ret=0の時に、display_nameを表示するのだと思い、
1つめのif文を
If ret <> 0 Then
→
If ret = 0 Then
に変え、1つ目でret = 0でパスしてるので、
２つ目のif文条件に　ret=0は不要と判断して削除した次第です。

なお、言われるとおり、
If ret = 0 Then
→
If ret <> 0 Then
にすると、win10でマクロ動作しました。

win7では、If ret = 0 ThenでもIf ret <> 0 Thenでも両方共マクロ動作するというのが？ですが、
If ret <> 0 Then
にてwin10がマクロ動作したので、本件クローズさせていただきます。

回答No.1

unokwave

私のWindows10 64bitにOffice 365 64bit版の組み合わせでは最初のGetStringValueで一度も取得に成功しません。
https://qiita.com/mckee/items/30d7b37c512c558ee937
こちらのやり方ならQuietDisplayNameでNullが返ってくる以外は正常に動作します。