|
ま、ここは仕事の内容を相談するところじゃないから、説明は分からないけど始めに
戻って OnTime の方を進めてみましょう。昨日、私がレスしたコードは見ていない
のかもしれないけど、少し無駄を省いて再掲しておきます。
Sub SC_Start()
Dim Lst As Date
Do
Lst = Application _
.InputBox("処理時間を10分以内で入力して下さい", _
, "00:00:30", Type:=1)
If Lst = False Then Exit Sub
Loop While IsDate(Lst) = False Or Lst > TimeValue("00:10:00")
Lst = Time + TimeValue(Lst)
Call MySC(Lst)
End Sub
Sub MySC(Lst As Date)
Application.OnTime Time + TimeValue("00:00:03"), _
"'Ck_File" & """" & Lst & "'"
End Sub
Sub Ck_File(Lst As Date)
Dim MyF As String
Dim WshShell As Object
If Time > Lst Then
MsgBox "処理時間が経過したので終了します", 64: Exit Sub
End If
MyF = Dir(Application.DefaultFilePath & "\*.xls")
If MyF <> "" Then
Set WshShell = CreateObject("WScript.Shell")
WshShell.Popup MyF, 2
Set WshShell = Nothing
End If
Call MySC(Lst)
End Sub
>「別フォルダーへコピー&リネームする」
が目的なら、
Dim WshShell As Object
を削除して
MyF = Dir(Application.DefaultFilePath & "\*.xls")
If MyF <> "" Then
Set WshShell = CreateObject("WScript.Shell")
WshShell.Popup MyF, 2
Set WshShell = Nothing
End If
の部分を変更するだけで、出来るでしょう。コピーではなく移動でよいなら、
Nameステートメントのコードを1行でやってしまえます。ヘルプを調べて
改造してみて下さい。
|
|