1
0

Delete article

Deleted articles cannot be recovered.

Draft of this article would be also deleted.

Are you sure you want to delete this article?

More than 3 years have passed since last update.

Excel VBA インストールされているExcelが64bitか32bitかを返す関数 ExcelIs64bit

Posted at

#常識的な32bitインストールがされていることが条件です
すると、x86がパス名にあると32bitのExcelということになります。

64 ビット版または 32 ビット版の Office を選択する

32 ビット版を選択する理由
次のコンピューター システムでは、32 ビット版の Office のみインストールできます。 Windows バージョンを確認する。

  1. ARM ベース プロセッサを使用する 64 ビット版のオペレーティング システム
  2. x86 (32 ビット) プロセッサを使用する 32 ビット版のオペレーティング システム
  3. 4 GB 未満の RAM(新しいOFFICEのみ)

と32bit 版のWindowsの場合としている

必ず32bit版であるのは34

上記のうち4 GB 未満の RAMはちょっと怪しい。当方のPCはキーボードはEndキーがあるが、いかんせん激安商品で物理メモリは3982KBで4GB未満であるが64bitである。
アップグレードで推移しているからかもしれないが、とりあえず、この条件を調べられるようにして、64/32の判定では使わない。
また、仮に32bit版しかインストール出来ない場合でもその場所はx86だと考えられるため、この条件を使わなくても判定できると思われる。
違う場合には教えて下さい。

OfficeTanaka御大が間違ったか、仕様が変更になった?

メモリの状況を取得する

上記のコードで使用している「Application.MemoryTotal」「Application.MemoryUsed」「Application.MemoryFree」は、Excel 2007以降使えなくなりました。

昔のExcelは便利だったねえ。
それはさておき物理メモリの値を取るための Win32 APIが紹介されている。

Win32 API、GlobalMemoryStatusの64bit化(条件分岐編纂命令不使用)

田中御大のコードを書き換えよう。
しかし、これは複雑な条件はないので、LongをLongPtrにする

Private Declare PtrSafe Sub GlobalMemoryStatus Lib "kernel32" (lpBuffer As MEMORYSTATUS)
Private Type MEMORYSTATUS
    dwLength As LongPtr
    dwMemoryLoad As LongPtr
    dwTotalPhys As LongPtr
    dwAvailPhys As LongPtr
    dwTotalPageFile As LongPtr
    dwAvailPageFile As LongPtr
    dwTotalVirtual As LongPtr
    dwAvailVirtual As LongPtr
End Type
Sub Sample()
Dim Memc as Currency
With MemData
  memc = CCur(CCur(.dwTotalPhys / 1024) / 1024)
End With
Debug.Print memc
End Sub

MemData.dbTotalPhysが使用可能メモリしか表示しない

Currency型なのはメモリをByte数で取るため、非常に大きいためである。
しかし、これで計算すると物理メモリの合計ではなく、へんな値が出て毎回変動する。
Sysinfoと比較すると、これはどうも使用可能メモリらしい。

しかしVBの例
http://hanatyan.sakura.ne.jp/vb2005/vb2013systeminfo09.htm
を見ても構造体は同じようにみえる。
レスキュー花ちゃんでも以下のような断り書きがある。
どうもうまくいかないらしい。
そして、この断り書きの通り、マニュアルの表現が違い、じゃあ、Officeの4GBのRAMは物理メモリなのかいまはわかりづらいです。
なにしろシンクライアントのような仮想端末の場合は4GBのRAMがあることになっているだけで、仕様を変更することができる。
そうなってくるとカタログ値で見ることができない。
またギリギリの場合どうか。厳密にいうと4GBと書いてあるのは4*1024=4096MBだが、3962MBで4GBのように書いてある場合がある。

おことわり
 WMI と Win32 API とでは、物理メモリ以外で呼び方?、集計方法が違うようです。(私の理解不足!)
 (理屈はともかく、ご自分の知りたいメモリ情報が解ればいいかなと...。)
 詳しくは、MSDN の掲載サイトを調べて下さい。

前回のx86の32bit判定を使う。

Excel.Application.PathでExcel.exeの場所が返る。
標準的なインストールならまず%programfiles(x86)%\Microsoft Office\Root\Office16にある。
Surfaceはこうではないと言われているが検証ができる資料がない。だれかサーフィス買ってください。

現行のWin10 2021H2相当の物理メモリはWMIを使うと出せる

物理メモリ容量を取得する: Win32_ComputerSystem - WMI Sample (VB) WMI FUN!
このサンプルを遅延バインディングで使うことで、SystemInfoと同じ容量を獲得できた。

ARM64の判定は環境変数を使う

ARM64は32bitしかインストールできない(ホントかな)とMSは言っています。なので、ARM64の場合はそのあとの検証をせず32bitと判定してFalseを返します。
ARM64の説明は以前も紹介したこちらの記事
https://urashita.com/archives/12325
がわかりやすいです。
あとはIA64がありえます
https://qiita.com/hot_study_man/items/a3b856085731b0e1f8d4
しかし、もうこれは製造中止で受注もできません。
https://pc.watch.impress.co.jp/docs/news/1168049.html
PCでVBAを使っている場合はまずAMD64のハズです。
ARM64は環境変数で除外していいようです。スマホだとそもそもVBAが動かないしフォルダの場所も違います。

Function ExcelIs64Bit() As Boolean
' For Excel 2010 Later
' For Word 2010 Later
' Excelが64bitか32bitか判定し、64bitの場合 Trueを返す
' Windows 10のみ、Surfaceなど、通常とインストール場所が異なる場合は動作しない可能性がある

Dim CsSet 'As SWbemObjectSet
Dim Cs 'As SWbemObject
Dim Locator 'As SWbemLocator
Dim Service 'As SWbemServices
Dim Ret As Currency
'Dim msg As String, MemData As MEMORYSTATUS
'GlobalMemoryStatus MemData
'Dim memc As Currency
Set Locator = CreateObject("WbemScripting.SWbemLocator")
Set Service = Locator.ConnectServer
Set CsSet = Service.ExecQuery("Select * From Win32_ComputerSystem")

For Each Cs In CsSet
Ret = Cs.TotalPhysicalMemory
Next

Debug.Print Int(((Ret / 1024) / 1024) + 0.5)
 ' 4 GB 未満の RAMだと32bitしかインストール出来ないようにMSは書いているが、実際はインストールできる
If Int(((Ret / 1024) / 1024) + 0.5) < (4 * 1024) Then
Debug.Print "4GB未満 32bit 推奨"
End If
'With MemData
'  memc = CCur(CCur(.dwTotalPhys / 1024) / 1024)
'End With
'Debug.Print memc
' Excelが64bit ならtrue そうでなければFalseを返す
Dim WSH As Object: Set WSH = CreateObject("WScript.Shell")
If WSH.expandenvironmentstrings("%PROCESSOR_ARCHITECTURE%") = "ARM64" Then ExcelIs64Bit = False: Exit Function
#If Win64 Then
' 次のコンピューター システムでは、32 ビット版の Office のみインストールできます。 Windows バージョンを確認する。
' ARM ベース プロセッサを使用する 64 ビット版のオペレーティング システム
If WSH.expandenvironmentstrings("%PROCESSOR_ARCHITECTURE%") = "ARM64" Then ExcelIs64Bit = False: Exit Function
If Application.Path Like "*(x86)*" Then ExcelIs64Bit = False: Exit Function Else ExcelIs64Bit = True: Exit Function
ExcelIs64Bit = True
Exit Function
#ElseIf Win32 Then
'x86 (32 ビット) プロセッサを使用する 32 ビット版のオペレーティング システム
ExcelIs64Bit = False
Exit Function
#End If
End Function

意外に存在していない物理メモリとExcel自体の判定

これで完全かは不明ですが、大多数のWindows 10 PCでは作動するでしょう。

Excel以外でもOutlook、Accessで使えそう

上記をApplication.Pathとしているので、Word,PowerPointでも使えると思います。
Outlookにはこのようなプロパティはないようなので、Excelを使う必要があります。
AcccessはSysCmd(9)を使うみたいですがちょっと調子が悪いので検証します。

Sub wdTest()
Dim wApp As Object: Set wApp = CreateObject("Word.Application")
Debug.Print wApp.Path
wApp.Quit
Set wApp = Nothing
End Sub

##使いみち
64bitと32bitではテーマの所在するフォルダが異なります。
このときに適切なフォルダを選ぶには64bitか32bitを判定するほうがいい場合があります。
もっともApplicationから単純に使えそうですが。
あとはたくさんのPCが64/32が混在している状況で、いっぺんに判定してくときでしょうか。

Dim xlApp : Set xlApp = CreateObject("Excel.Application") 
IF xlApp.Path Like "*(x86)*" Then

' この場合、必ずExcelをQuitで終了させないと残ってしまうので、この週末処理をExit Functionの前に実行する必要があります
' 遅延バインディングのため重いです
xlApp.Quit
Set xlApp = Nothing

のようにもってくると使えるでしょう。

1
0
4

Register as a new user and use Qiita more conveniently

  1. You get articles that match your needs
  2. You can efficiently read back useful information
  3. You can use dark theme
What you can do with signing up
1
0

Delete article

Deleted articles cannot be recovered.

Draft of this article would be also deleted.

Are you sure you want to delete this article?