| |
全て同じモジュールに貼り付けて、Mainを実行。
ワイルドカードやタイトルの指定は全てMainで行い、関数に引数を渡す。
'ここから====
'//API宣言部
Declare Function GetOpenFileName Lib "comdlg32.dll" Alias "GetOpenFileNameA" (pOpenfilename As OPENFILENAME) As Boolean
Type OPENFILENAME
lStructSize As Long
hwndOwner As Long
hInstance As Long
lpstrFilter As String
lpstrCustomFilter As Long
nMaxCustrFilter 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
lCustrData As Long
lpfnHook As Long
lpTemplateName As String
End Type
'//関数
Private Function GetFile(ByVal Filt As String, FiltName As String, MsgTitle As String) As String
Dim retc As Long
Dim filn As OPENFILENAME
Dim Tmpfile As String
Dim TmpFileTitle As String
Dim fileToOpen As String
Dim STIME As Integer
'
Tmpfile = String(256, 0)
TmpFileTitle = String(256, 0)
'設定いろいろ
With filn
.lStructSize = Len(filn)
.hwndOwner = hWndAccessApp
.hInstance = 0
.lpstrFilter = FiltName & Chr$(0) & Filt & Chr$(0) & Chr$(0)
.lpstrCustomFilter = 0
.nMaxCustrFilter = 0
.nFilterIndex = 0
.lpstrFile = Tmpfile
.nMaxFile = 256
.lpstrFileTitle = TmpFileTitle
.nMaxFileTitle = 511
.lpstrInitialDir = CurDir()
.lpstrTitle = MsgTitle & ":" & Filt & "限定"
.Flags = 0
.nFileOffset = 0
.nFileExtension = 0
.lpstrDefExt = ""
.lCustrData = 0
.lpfnHook = 0
.lpTemplateName = 0
End With
'
retc = GetOpenFileName(filn)
fileToOpen = Left(filn.lpstrFile, InStr(filn.lpstrFile, Chr(0)) - 1)
If Dir(fileToOpen) <> "" Then
GetFile = fileToOpen
Else
GetFile = ""
End If
End Function
'//実働部分
Sub MAIN()
Dim Filt As String, Ifile As String
'ワイルドカード指定
Filt = "Book*.xls"
Ifile = GetFile(Filt, "読み込みたいファイル", "ファイルを選択してください")
'
If Ifile = "" Then
MsgBox "CANCEL", vbCritical
Else
Workbooks.Open Ifile
End If
End Sub
'ここまで====
動作確認 2005/4/23 Win98SE,XL2000
|
|
![[未読]](./data/FAQ/image/read_icon.gif){kind=icon}
- 05/4/23(土) 9:30 -
