VBA Windowsプログラムからアイコンを抽出する方法

Question

Windowsプログラムからアイコンを抽出する方法を探していたら、

次の方法を見つけました。が、私はVB開発環境を持っていません。

Excel2010-VBAで同じことをしたいのですがコンパイルエラーが発生…当然だと思います。

Excel2010-VBAで動作させるには次のコードをどのように変更すればよいか、

ご教授宜しくお願い致します。

---

文書番号: 185883

Windows プログラムからアイコンを抽出するには

[http://support.microsoft.com/kb/185883/ja]

---

Option Explicit

Private Const MAX_PATH = 260

Private Declare Function GetSystemDirectory Lib "kernel32" Alias _

"GetSystemDirectoryA" (ByVal lpBuffer As String, _

                       ByVal nSize As Long) As Long

Private Declare Function ExtractIcon Lib "shell32.dll" Alias _

"ExtractIconA" (ByVal hInst As Long, _

                ByVal lpszExeFileName As String, _

                ByVal nIconIndex As Long) As Long

Private Declare Function DrawIcon Lib "user32" (ByVal hdc As Long, _

ByVal x As Long, ByVal y As Long, ByVal hIcon As Long) As Long

Dim path$, nIcon As Long

Private Sub Command1_Click()

    Dim hIcon As Long

    hIcon = ExtractIcon(App.Hinstance, path$, nIcon)

    Set Picture1.Picture = LoadPicture("") ' Clear the picture box

    Picture1.AutoRedraw = True

    Call DrawIcon(Picture1.hdc, 0, 0, hIcon)

    Picture1.AutoRedraw = False

    Picture1.Refresh

    nIcon = nIcon + 1

End Sub

Private Sub Form_Load()

' Store the full path to the file containing the icon(s).

    path$ = Space$(MAX_PATH)

    Call GetSystemDirectory(path$, MAX_PATH)

    path$ = Trim$(path$) ' Trim trailing blanks & Null terminator

    path$ = Left$(path$, Len(path$) - 1) & "\Shell32.dll"

    nIcon = 0

End Sub

---

以上

Answer 1

手前味噌で恐縮ですが、私のサイト

http://www16.plala.or.jp/ysakuda/ystop.htm

のVBAのページその２に、「アイコンギャラリ」というのがあります。

コードは隠していませんのでコードを見てください。多分間違えなく同じことをやってるはずです。

（面倒なので中身は確認してませんがｗ）

なお、掲載してあるファイルはｘｌｓになっていますが、そのままでもExcel2013でも動くようです。

ただし、APIを使用していますので、OSも32ビット環境でないとだめです。

私は全く環境をもっておりませんがもし64ビットのWindows+Officeをお使いならその点も明示されて、64ビットAPIに書き換えたい等の質問をされた方が良いと思います。

Answer 2

sakudaさん、早々の回答有難うございます。

早速「アイコンギャラリ」をダウンロードさせていただきました。

Windows7(32bit)+Excel2010(32bit)で正常に動作した事を報告します。

目的通りの内容でした…感謝

「拡張子の詳細記述にDefaultIconが無ければ、CISIDをたどり

 そこからDLLのファイル名を取得」…素晴らしい。

とても非力な私には「目から鱗」です。

本当に有難うございました。

以上