設定
- A列にファイルのフルパス。
- M列にネットワークフォルダがある。ただし、末尾に円マークはない。 \Server\name\folder のような感じ。
やりたいこと
- M列にフォルダが入っている場合だけ、A列のファイルをコピーしたい。
- 【重要】上書きしても構わない。が一応サンプルでは上書きを止めている
- Scripting.FileSystemObjectを事前に参照設定すること
Sub DeliverFile()
' For Excel VBA
' Reference Setting Microsoft Scripting Runtime
Dim FSO As New Scripting.FileSystemObject
Dim oFile As File
Dim oFolder As Scripting.Folder
Dim r As Range
Dim LastRow As Long, iCol As Long, iRow As Long
Dim wb As Workbook: Set wb = ThisWorkbook
Dim ws As Worksheet: Set ws = wb.Worksheets(1)
lastrow = ws.Range("A" & Rows.Count).End(xlUp).Row
For iRow = LastRow To 2 Step -1 ' 1行目に列見出しが入っているため、最後は2行目になる。こういう時は最後から最初に向かうのがセオリー。
If FSO.FileExists(Cells(iRow, 1)) Then
Set oFile = FSO.GetFile(Cells(iRow, 1))
Set r = ws.Range("M" & iRow)
If r.Value <> "" And FSO.FolderExists(r.Value & "\") Then
Set oFolder = FSO.GetFolder(r.Value & "\")
If Not FSO.FileExists(oFolder.Path & "\" & oFile.Name) Then
FileCopy oFile.Path, oFolder.Path & "\" & oFile.Name
End if
End If
End If
Next
End Sub
ポイント
ネットワークフォルダはN:\などとせずURN表記\Server\name\を使用する
これに対してA列のソースファイルはN:\といった割りてられたドライブレターでもよい。
最後は末尾の円マークというかスラッシュがないので追加する。
FolderExistsは最後に円マークがないとエラーになる。
FileCopyはVBAならではの命令。これは、コピー先のフォルダ名だけではなく、ファイル名まで続ける。
Filecopy "E:\hoge\text.txt, "E:\hogehoge\text.txt" という表記になる。 ここでoFile.Pathでフルパス、oFile.NameでBasename+Extentionを使ってそれを実現している。 oFolder.Path と oFile.path と oFile.name は混乱しがちだが、このサンプルでわかると思う。 次に、Folder名の修飾子はScriptingになる。単純にAs Folder`だとエラーになった。しかし、これはほかにも参照設定していたからかもしれない。
ただ、正確にはScriptingになるというのはちょっと思いつかなかった。これはこれからも使えると思う。わかりにくいバグを回避できる。
単純にFolderだけだといろいろなアプリケーションがオブジェクトに含んでいるので、たくさんの参照設定をしていればVBAも混乱するのかもしれない。
こういうエラーもあるということがわかった。またこのようなエラーが起きる場合、明示的に修飾子を使い、エラーを防ぐほうが良いことも分かった。
課題
これとFSOのコピーを比較してどちらが早いかを調べる。
体感的にはこのFileCopyの方が早いという感じがした。
留意点
https://www.moug.net/tech/exvba/0060075.html
このFileCopyは上書きを強制するので注意。
上書きを回避するには、この記事の方法のほか、Dir命令などを用いて、ファイルの有無を判定してからコピーする。