API関数GetOpenFileNameを、VBAから呼び出して使うプログラム例です。標準モジュールにコピー
して使ってみてください。
Public Type OPENFILENAME
lStructSize As Long
hwndOwner As Long
hInstance As Long
lpstrFilter As String
lpstrCustomFilter As String
nMaxCustFilter As Long
nFilterIndex As Long
lpstrFile As String
nMaxFile As Long
lpstrFileTitle As String
nMaxFileTitle As Long
lpstrInitialDir As String
lpstrTitle As String
flags As Long
nFileOffset As Integer
nFileExtension As Integer
lpstrDefExt As String
lCustData As Long
lpfnHook As Long
lpTemplateName As String
End Type
Public Declare Function GetOpenFileName Lib "comdlg32.dll" Alias "GetOpenFileNameA" _
(pOpenfilename As OPENFILENAME) As Long
Public Const OFN_FILEMUSTEXIST = &H1000
Public Const MAX_PATH = 260
以上をDeclarationsに書いてください。以下はユーザー定義関数です。
以下のTst_APIShowをVB Editorから実行するとプログラムの動作を見ることが出来ます。
Public Sub Tst_APIShow()
'
' WindowsAPI関数GetOpenFileNameを呼び出してオープンするファイル名(フルパス名)
'を得るテストプログラム
'
Dim full_path_name As String, title_name As String
Dim opn_file_name As OPENFILENAME
Dim output_string As String
'
' opn_file_nameの初期化全てのメンバをナルに
'
Call Initialize_Struct(opn_file_name)
'
'full_path_nameとtitle_nameの文字数を設定する
'
full_path_name = String(260, " ")
title_name = String(64, " ")
If Set_StructMem(opn_file_name, full_path_name, title_name) <> False Then
MsgBox full_path_name
End If
End Sub
Public Function Set_StructMem(opn_name_strct As OPENFILENAME, file_full_title As String, file_title As String) As Long
'
'注意 ナル文字(\0)等の取得方法がC言語と違っている
'lpstrFilterでフィルタ文字列に空白を入れてはならない
'
Dim flag_val As Long
opn_name_strct.lStructSize = 76&
opn_name_strct.hwndOwner = 0&
opn_name_strct.lpstrFilter = "全ての図" & Chr("\0") & "*.bmp;*.jpg;*.gif;*.ico;*.wmf" & Chr("\0") & Chr("\0")
opn_name_strct.lpstrCustomFilter = vbNullString
opn_name_strct.lpstrFile = file_full_title
opn_name_strct.nMaxFile = MAX_PATH
opn_name_strct.lpstrFileTitle = file_title
opn_name_strct.nMaxFileTitle = 64&
opn_name_strct.lpstrTitle = "表示する図・写真・絵を選んでください"
opn_name_strct.flags = OFN_FILEMUSTEXIST
Set_StructMem = GetOpenFileName(opn_name_strct)
file_full_title = opn_name_strct.lpstrFile
End Function
Public Sub Initialize_Struct(opn_name_strct As OPENFILENAME)
'
' OPENFILENAME構造体を初期化する。文字列の初期化に注意
'
With opn_name_strct
.lStructSize = 0&
.hwndOwner = 0&
.hInstance = 0&
.lpstrFilter = vbNullString
.lpstrCustomFilter = vbNullString
.nMaxCustFilter = 0&
.nFilterIndex = 0&
.lpstrFile = vbNullString
.nMaxFile = 0&
.lpstrFileTitle = vbNullString
.nMaxFileTitle = 0&
.lpstrInitialDir = vbNullString
.lpstrTitle = vbNullString
.flags = 0&
.nFileOffset = 0
.nFileExtension = 0
.lpstrDefExt = vbNullString
.lCustData = 0&
.lpfnHook = 0&
.lpTemplateName = vbNullString
End With
End Sub