| |
こんなかな？
以下を全て標準モジュールに記述してください
Option Explicit
Public Sub Sample()
Dim i As Long
Dim vntDate As Variant
Dim strPath As String
Dim vntFileNames As Variant
Dim strProm As String
strProm = "処理する日付を入力してください。"
Do
vntDate = InputBox(strProm, "日付入力", Date)
If IsDate(vntDate) Then
Exit Do
Else
strProm = "日付が間違っていますので、再度入力してください。"
End If
Loop Until vntDate = ""
'キャンセルボタンが押された時
If vntDate = "" Then
strProm = "マクロがキャンセルされました"
GoTo Wayout
End If
'ファイルのBaseNameを作成
vntFileNames = Format(DateValue(vntDate), "yy-mm-dd") & "*"
'ダイアログを開くフォルダを指定
strPath = ThisWorkbook.Path
'ダイアログを開く
If Not GetReadFile(vntFileNames, strPath, True) Then
strProm = "ファイル選択がされませんのでマクロを終了します"
GoTo Wayout
End If
'画面更新を停止
' Application.ScreenUpdating = False
For i = 1 To UBound(vntFileNames)
MsgBox vntFileNames(i) & "を開きます"
' Workbooks.Open FileName:=vntFileNames(i)
'ここに一連の処理プログラムを挿入する。
Next i
strProm = "処理が完了しました"
Wayout:
'画面更新を再開
Application.ScreenUpdating = True
MsgBox strProm, vbInformation
End Sub
Private 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
- 07/3/12(月) 18:58 -
