| |
こんなので上手く行くかな？
尚、「2004.08.25A.EXL」て「2004.08.25A.xls」の間違い？
以下を標準モジュールに記述して下さい
Option Explicit
Public Sub Sample1()
' ファイルを単独で選択する場合
Dim strPath As String
Dim vntFileName As Variant
'パスを指定
' strPath = "C:\DATA"
strPath = ThisWorkbook.Path
'表示させるFile名を指定
' vntFileName = Format(Date, "yyyy.mm.") & "25A"
vntFileName = Format(Date, "yyyy.mm.") & "??A"
If Not GetReadFile(vntFileName, strPath, False) Then
Exit Sub
End If
'*.xlsを開く
Workbooks.Open vntFileName
End Sub
Public Sub Sample2()
' ファイルを複数選択する場合
Dim i As Long
Dim strPath As String
Dim vntFileName As Variant
'パスを指定
' strPath = "C:\DATA"
strPath = ThisWorkbook.Path
'表示させるFile名を指定
' vntFileName = Format(Date, "yyyy.mm.") & "25A"
vntFileName = Format(Date, "yyyy.mm.") & "??A"
If Not GetReadFile(vntFileName, strPath, True) Then
Exit Sub
End If
'*.xlsを開く
With Workbooks
For i = 1 To UBound(vntFileName)
.Open vntFileName(i)
Next i
End With
End Sub
Public Function GetReadFile(vntFileNames As Variant, _
Optional strFilePath As String, _
Optional blnMultiSel As Boolean _
= False) As Boolean
Dim strFilter As String
'フィルタ文字列を作成
strFilter = "Excel File (*.xls),*.xls," _
& "全て (*.*),*.*"
'読み込むファイルの有るフォルダを指定
If strFilePath <> "" Then
'ファイルを開くダイアログ表示ホルダに移動
ChDrive Left(strFilePath, 1)
ChDir strFilePath
End If
'もし、ディフォルトのファイル名が有る場合
If vntFileNames <> "" Then
SendKeys vntFileNames & "{TAB}", False
End If
'「ファイルを開く」ダイアログを表示
vntFileNames _
= Application.GetOpenFilename(strFilter, 1, , , blnMultiSel)
If VarType(vntFileNames) = vbBoolean Then
Exit Function
End If
GetReadFile = True
End Function
|
|
Hirofumi
- 04/8/28(土) 8:31 -
