No.3ベストアンサー
- 回答日時:
No1です。
No1に提示された仕様でマクロを作成しました。標準モジュールへ登録してください。
ーーーーーーーーーーーーーーーーーーーーーーーーーーーー
Option Explicit
Public Sub ファイル移動()
Dim sh As Worksheet '管理シート
Dim fromF As String '監視フォルダ
Dim toF As String '移動先フォルダ
Dim sdate As Variant '開始日(yyyy/mm/dd)
Dim edate As Variant '終了日(yyyy/mm/dd)
Dim stime As Variant '開始時刻(hh:mm:ss)
Dim etime As Variant '終了時刻(hh:mm:ss)
Dim fname As String 'ファイル名
Dim fpath As String 'ファイルパス名
Dim ftime As Date 'ファイル更新日時
Dim s_ftime As Date '開始日時
Dim e_ftime As Date '終了日時
Dim cnt As Long 'ファイル件数
Dim files() As String '移動対象ファイルの配列
Dim fileNames As String '移動対象ファイルの一覧
Dim ans As Long
Dim i As Long
Set sh = Worksheets("管理")
fromF = sh.Cells(1, "B").Value
toF = sh.Cells(2, "B").Value
toF = sh.Cells(2, "B").Value
sdate = sh.Cells(3, "B").Value
stime = sh.Cells(4, "B").Value
edate = sh.Cells(5, "B").Value
etime = sh.Cells(6, "B").Value
If Dir(fromF, vbDirectory) = "" Then
MsgBox ("監視フォルダエラー")
Exit Sub
End If
If Dir(toF, vbDirectory) = "" Then
MsgBox ("移動先フォルダエラー")
Exit Sub
End If
If sdate = "" Then
sdate = Date
End If
If edate = "" Then
edate = Date
End If
If sdate > edate Then
MsgBox ("日付指定エラー")
Exit Sub
End If
If sdate = edate And stime > etime Then
MsgBox ("時刻指定エラー")
Exit Sub
End If
s_ftime = sdate + stime
e_ftime = edate + etime
cnt = 0
' 先頭のファイル名の取得
fname = Dir(fromF & "\*.xlsx", vbNormal)
' ファイルが見つからなくなるまで繰り返す
Do While fname <> ""
ftime = FileDateTime(fromF & "\" & fname)
'そのファイルの更新時刻が、指定された開始時刻~終了時刻なら移動する
If ftime >= s_ftime And ftime <= e_ftime Then
ReDim Preserve files(cnt)
files(cnt) = fname
cnt = cnt + 1
fileNames = fileNames & vbLf & fname
End If
' 次のファイル名を取得
fname = Dir()
Loop
If cnt = 0 Then
MsgBox ("移動対象ファイルなし")
Exit Sub
End If
ans = MsgBox(cnt & "件の移動対象ファイルがあります。移動しますか?" & fileNames, vbOKCancel)
If ans <> vbOK Then Exit Sub
For i = 0 To cnt - 1
fname = files(i)
fpath = toF & "\" & fname
'移動先に同一ファイルが存在するなら削除する
If Dir(fpath) <> "" Then
Kill fpath
End If
'ファイルの移動
Name fromF & "\" & fname As fpath
Next
MsgBox ("ファイル移動完了")
End Sub
-----------------------------------------
不具合、不明点があれば補足ください。
ありがとうございます
こんな短時間で感服しました
フォルダ及びご提案頂いたEXCELファイル作成し早速試してみました、日付の書式の部分で若干躓きましたが
問題なく出来ました
勉強になりますシンプルなので
正規のフォルダ設定し本番に使わせていただきます
No.2
- 回答日時:
以下で、設定の仕方がわかれば、使いこなせるかと思います。
一通りのエラー処理はしてあります。
しかし、今は、同名ファイルに関しては、エラーを出して終わるだけにとどまっています。
なお、設定部分だけ、シートに持ってきても良いかとは思います。それは、おまかせします。
'// 標準モジュール
Sub RangeDatesSpecializing()
Dim FTime As Variant
Dim LTime As Variant
Dim fDate As Variant
Dim i As Long, j As Long
Dim FName As String, tmp
Dim Aryfiles() As String
Dim objFS As Object
Dim mPath As String
Dim Destin As String
Dim Ext As String
Dim f As Variant
On Error GoTo ErrHandler
'****************************
'ソース元
mPath = "C:\Users\Temp1\"
'移動先
Destin = "C:\Users\Temp2\Excelfiles\"
FTime = "2016/04/01 00:10" '初め
LTime = "2016/04/28 0:00" '終わり
'拡張子
Ext = ".xlsx"
'**************************
'------------Error Check 開始 ----------
If Right$(Destin, 1) <> "\" Then Destin = Destin & "\"
If Right$(mPath, 1) <> "\" Then mPath = mPath & "\"
If Dir(mPath, vbDirectory) = "" Then MsgBox "フォルダーが存在していません。", vbExclamation: Exit Sub
If Dir(Destin, vbDirectory) = "" Then MsgBox "フォルダーが存在していません。", vbExclamation: Exit Sub
FTime = CDate(FTime)
LTime = CDate(LTime)
If FTime > LTime Then
tmp = LTime: LTime = FTime: FTime = tmp
End If
If Ext = "" Then MsgBox "拡張子が記入されていません。", vbExclamation: Exit Sub
If Left$(Ext, 1) <> "." Then Ext = "." & Ext
'---------Error Check 終了 -----------------
Set objFS = CreateObject("Scripting.FilesystemObject")
ReDim Aryfiles(1000)
FName = Dir(mPath & "*" & Ext, vbNormal)
Do While FName <> ""
If FName <> "." And FName <> ".." Then
If (GetAttr(mPath & FName) And vbNormal) = vbNormal Then
fDate = objFS.GetFile(mPath & FName).DateLastModified
If fDate >= FTime And LTime >= fDate Then
Aryfiles(i) = FName
i = i + 1
If i > 1000 Then MsgBox "取扱ができません", vbCritical: Exit Sub
End If
End If
End If
FName = Dir
Loop
If i > 0 Then
ReDim Preserve Aryfiles(i - 1)
For Each f In Aryfiles
' On Error Resume Next
objFS.MoveFile mPath & f, Destin
'On Error GoTo 0
j = j + 1
Next f
Else
MsgBox "ファイルが見つかりません", vbExclamation
End If
ErrHandler:
If Err.Number Then
MsgBox Err.Number & ": " & Err.Description & vbCrLf & _
"ファイルの移動に失敗しました。", vbExclamation
ElseIf j > 0 Then
MsgBox "ファイルの移動" & j & "個が完了しました", vbInformation
End If
Set objFS = Nothing
End Sub
'//
ありがとうございます
設定の仕方について確認しフォルダ設定を変更して試してみました
問題なく動作しました
エラーの処理設定 の部分は特に参考になりますありがとうございました
No.1
- 回答日時:
添付の図のようにシート名:"管理"のシートに
B1にエクセルファイルが書き込まれるフォルダ
B2に移動先のフォルダ
B3に開始指定日時の日付(年月日)
B4に開始指定日時の時刻(時分秒)
B5に終了指定日時の日付(年月日)
B6に終了指定日時の時刻(時分秒)
を記入し、マクロが実行されたとき、
excelファイルの更新時刻が開始指定日時~終了指定日時の範囲内であれば、そのファイルを移動先へ転送するようにします。
尚、”他システムより定時間毎にエクセルファイル(.xlsx)が任意の名前で保存され蓄積されていきます”
ということなので、マクロが毎日実行されることを考慮し、
B3とB5の日付は空白の場合、マクロが実行された当日の日付を採用するようにします。
(もちろん、日付が指定された場合はその日付に従います)
上記のような仕様でいかがでしょうか。
ありがとうございました
仕様を分かりやすくまとめて頂き
マクロの記述のイメージが沸いています、具体的な記述がどうなるか考えてみます
お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!
似たような質問が見つかりました
- Excel(エクセル) エクセルのマクロについて教えてください。 1 2023/02/06 13:01
- Excel(エクセル) エクセルのマクロについて教えてください。 2 2023/02/04 12:47
- Excel(エクセル) エクセルのマクロについて教えてください。 1 2023/02/21 09:28
- Excel(エクセル) 1つのファイルを3つのフォルダにファイル名を【明日の日付】にして、コピーをしたい 2 2022/12/21 17:43
- Visual Basic(VBA) エクセルのマクロについて教えてください。 4 2023/05/24 08:33
- Visual Basic(VBA) エクセルのマクロについて教えてください。 1 2023/08/08 11:02
- Visual Basic(VBA) エクセルのマクロについて教えてください。 1 2023/02/21 11:19
- Visual Basic(VBA) エクセルのマクロについて教えてください。 1 2023/03/07 14:05
- Visual Basic(VBA) VBAが止まります。 2 2022/09/02 14:02
- Visual Basic(VBA) Excelのマクロについて教えてください。 作業フォルダ内に2つのファイルがあります。 このファイル 2 2023/07/09 13:40
関連するカテゴリからQ&Aを探す
おすすめ情報
デイリーランキングこのカテゴリの人気デイリーQ&Aランキング
-
batでファイル名を変更したい(...
-
CSVファイルの特定行の削除
-
vbsからのExcelマクロ呼び出し...
-
EXCELVBAにて文字列にして「01...
-
エクセルで移動したシートを復...
-
5000個のtiffファイルをpdfへ変...
-
FTPのgetとputの使いわけ。
-
Excel: ファイル名になぜ、[...
-
複数のExcelファイルにある同名...
-
C# リッチテキスト形式のファイ...
-
彼女の過去の恋愛に嫉妬してし...
-
WINDOWS CMDからゴミ箱のファ...
-
Excelでファイルが開かない
-
【Excel VBA】ファイルにヘッダ...
-
アクセスが開かなくなってしま...
-
iCloud for Windowsをアンイン...
-
ファイルを別のフォルダに移動...
-
HTMLのリンクで、EXCELをIEでは...
-
バインダーの作り方
-
シェルでテキストファイルを半...
マンスリーランキングこのカテゴリの人気マンスリーQ&Aランキング
-
iPhoneで撮った動画をiPhoneの...
-
iCloud for Windowsをアンイン...
-
vbsからのExcelマクロ呼び出し...
-
複数のExcelファイルにある同名...
-
EXCELVBAにて文字列にして「01...
-
CSVファイルの特定行の削除
-
OneDrive必要なものでしょうか
-
Excel: ファイル名になぜ、[...
-
VBAにおいて、ファイルの移...
-
ファイルが移動してもリンクの...
-
FTPのgetとputの使いわけ。
-
[Unity]シーンファイルの中が消...
-
batでファイル名を変更したい(...
-
WINDOWS CMDからゴミ箱のファ...
-
エクセルのファイル:「自分」が...
-
5000個のtiffファイルをpdfへ変...
-
Excelに貼り付けた画像を圧縮す...
-
WinPCのメモ帳を、アンドロ...
-
HTMLのリンクで、EXCELをIEでは...
-
エクセル保存終了で一時ファイ...
おすすめ情報