| |
こんな感じになると思いますが、ﾌｧｲﾙ形式が不明の為
CVSなどのWORKBOOKを開くことを前提にしています。
参照設定もいったかもしれません（Microsoft Office 11.0 Object Libraly)
記憶が定かではありませんです。
Private Sub Worksheet_Change(ByVal Target As Range)
Dim STRFN As String
If Intersect(Target, Range("C8")) Is Nothing Then
Exit Sub
Else
STRFN = (Format(Range("C8"), "ddmmyy"))
Call Fileopen(STRFN)
End If
End Sub
Sub Fileopen(STRFN)
Dim myCurDir As String
Dim myFile As String
Dim myTitle As String
Const cnsTITLE = "フォルダ内のファイル名一覧取得"
Const cnsDIR = "\*.*"
Dim xlAPP As Application
Dim strPATHNAME As String
Dim strFILENAME As String
Dim s1 As Integer
'ﾌｧｲﾙを探したいﾌｫﾙﾀﾞを指定します
strPATHNAME = ThisWorkbook.Path & "\加工ﾃﾞｰﾀ"
'フォルダがあるか確認
If Dir(strPATHNAME, vbDirectory) = "" Then
MsgBox "指定のフォルダは存在しません。", vbExclamation, cnsTITLE
Exit Sub
End If
' 先頭のファイル名の取得
strFILENAME = Dir(strPATHNAME & cnsDIR, vbNormal)
'ﾌｧｲﾙがなくなるまで探します
Do While strFILENAME <> ""
'ファイル名にSTRFNが含まれなければ０が帰ります
s1 = InStr(strFILENAME, STRFN)
If s1 <> 0 Then '見つかればファイルをOPENただしこの場合はあWORKBOOKです。
Workbooks.Open Filename:=strPATHNAME & "\" & strFILENAME
Exit Sub
Else
strFILENAME = Dir()
End If
Loop
End Sub
|
|
keisuke
- 10/10/27(水) 19:20 -
