アプリ版:「スタンプのみでお礼する」機能のリリースについて

他サーバからファイルをダウンロードしようとしてます。日付指定です。タイムスタンプが日付1~日付2の間のファイルをコピーします。元ファイルフォルダにあるファイル全5千個から300個を選びコピーする形となります。

Dim f As Object
Dim FSO As New FileSystemObject
Dim Path1 As String, Path2 As String
Dim filename As String

Path1=’元ファイルのフォルダパス
Path2='ダウンロード先のフォルダパス
filename='コピーしたいファイル名

For Each f In FSO.GetFolder(Path1).Files
If f.DateLastModified >CDate('日付1指定) And f.DateLastModified <CDate('日付2指定) then
If f.Name Like "*" & filename & "*" then
FSO.CopyFile f.Path, Path2, True
End If
End If
Next f

問題点
実際のコピー作業以前に、5千個から条件に該当するファイルを選び出すのに時間が掛かり過ぎます。最初の条件該当が出て1個目コピーが始まるまで5分程度。ほぼ一瞬で終わることを期待してましたが、違いました。一個のコピー時間は現在不明です。

次善の策
一旦バッチファイルに以下のように出力すると、待ち時間なくコピー開始されます。
xcopy path1\*finename path2\ /d:月-日-年
しかし1個当たりのコピー時間が4秒と長いです。さらに日付は日付1しか指定出来ません。つまり○月×日以降のファイルを全部コピーします。

要は、速く期間指定でコピーしたいのです。何か良い方法はないでしょうか?

A 回答 (3件)

ScriptingFilesystem で試してみましたが


どんぐりの背比べ・・のような結果。
NAS上の1フォルダ中に320個のファイルがあるところでやってみました。
コピーしていませんので約4秒。

Option Explicit
Private Declare Function GetTickCount Lib "kernel32" () As Long

Sub てすと1()
Dim f As Object, fDate As Date
Dim FSO As FileSystemObject
Dim Path1 As String, Path2 As String
Dim fileName As String
Dim 日付1指定 As Date, 日付2指定 As Date
Dim tK As Long, i As Long

tK = GetTickCount
Set FSO = New FileSystemObject
Path1 = "m:\" '元ファイルのフォルダパス
Path2 = "" 'ダウンロード先のフォルダパス
fileName = "A" 'コピーしたいファイル名
日付1指定 = #1/1/2010#
日付2指定 = #1/1/2015#

For Each f In FSO.GetFolder(Path1).Files
fDate = f.DateLastModified
If fDate > 日付1指定 And fDate < 日付2指定 Then
If f.Name Like "*" & fileName & "*" Then
i = i + 1
'FSO.CopyFile f.Path, Path2, True
End If
End If
Next f
Set FSO = Nothing
Debug.Print i, GetTickCount - tK
End Sub

FSO.CopyFile ではなく、VBA の FileCopy メソッドだとどうかな?
目くそ鼻くそかもしれません。。。
    • good
    • 0
この回答へのお礼

ありがとうございます。
試してみます。

お礼日時:2015/03/26 19:49

まあ


> 1個当たりのコピー時間が4秒と長いです
というのがネットワーク間のコピー速度の限界ぽいので焼け石に水かもしれませんが、
> 5千個から条件に該当するファイルを選び出すのに時間が掛かり過ぎます
については
 CDate('日付1指定)、CDate('日付2指定)、"*" & filename & "*"
をループ中で毎回生成しているのがちょっと気になります。ループの外で変数を宣言してそれに上記の値を代入し、ループ中ではその変数と f.DateLastModified を比較してみたらいかがでしょうか。
    • good
    • 0
この回答へのお礼

ありがとうございます。
残念ながら変わりませんでした。どうやらf.Nameを一通り取得するだけでかなり時間がかかります。

お礼日時:2015/03/26 19:48

robocopy で出来きそうですが、すみません未検証です。


以下ヘルプの一部抜粋です。

/S :: サブディレクトリをコピーしますが、空のディレクトリはコピーしません。

/MAXAGE:n :: 最長ファイル有効期間 - n 日より古いファイルを除外します。
/MINAGE:n :: 最短ファイル有効期間 - n 日より新しいファイルを除外します。

n を絶対日?に指定できなさそうなので
/maxage:5
/minage:2
のようにしなくちゃダメっぽいです。
    • good
    • 0
この回答へのお礼

ありがとうございます。
どちらかと言うと継続的な丸コピーのためのコマンドのようですね。他に手がなければやってみますが、出来れば避けたいです。

お礼日時:2015/03/26 06:58

お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!

このQ&Aを見た人はこんなQ&Aも見ています