Excel VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちらをご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。


	新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム

4833 / 76807

←次へ　｜　前へ→


	【77590】Re:特定ファイルのコピーについて

β - 15/10/30(金) 17:52 -


	引用なし

	パスワード

▼SHO さん：

FSOを使ったほうが、そちらのコードにあうのでしょうが、標準機能だけで。
フォルダは、実際のものにしておいてください。

Sub Test()
　　Dim SFolder As String
　　Dim DFolder As String
　　Dim fName As String
　　Dim z As String
　　Dim ym1 As String
　　Dim ym2 As String
　　Dim ym As String
　　Dim tmp1 As Variant
　　Dim tmp2 As Variant
　　
　　Dim ok As Boolean
　　
　　z = Range("C8").Value
　　ym1 = Format(DateSerial(Left(z, 4), Mid(z, 5), 1), "yyyymm")
　　ym2 = Format(DateSerial(Left(z, 4), Mid(z, 5) + 1, 1), "yyyymm")
　　
　　SFolder = CreateObject("WScript.Shell").SpecialFolders("DeskTop") & "\SFolder\"
　　DFolder = CreateObject("WScript.Shell").SpecialFolders("DeskTop") & "\DFolder\"
　　
　　fName = Dir(SFolder & "*.xml")
　　
　　Do While fName <> ""
　　　　tmp1 = Split(fName, "_")
　　　　tmp2 = Split(tmp1(UBound(tmp1)), ".")
　　　　ok = False
　　　　ym = tmp2(LBound(tmp2))
　　　　Select Case Left(ym, 6)
　　　　　　Case ym1
　　　　　　　　If Right(ym, 2) <> "01" Then ok = True
　　　　　　Case ym2
　　　　　　　　If Right(ym, 2) = "01" Then ok = True
　　　　End Select
　　　　
　　　　If ok Then
　　　　
　　　　　　On Error Resume Next
　　　　　　Kill DFolder & fName
　　　　　　On Error GoTo 0
　　　　　　FileCopy SFolder & fName, DFolder & fName
　　　　
　　　　End If
　　　　　　
　　　　fName = Dir()
　　　　
　　Loop
　　
End Sub

2 hits

▼

【77589】特定ファイルのコピーについて SHO 15/10/30(金) 15:47