みんなの「教えて(疑問・質問)」にみんなで「答える」Q&Aコミュニティ

こんにちはゲストさん。会員登録(無料)して質問・回答してみよう!

解決済みの質問

エクセルVBAでセルにあるファイル名のファイルを同じくセルにあるフォルダ名のフォルダにコピー

お世話になります。
絶対パスがあり、コピー元、コピー先(格納先)としてシート上の操作で
ファイルをフォルダにコピーしたいのですが、VBAでできるでしょうか?

・B列B6以下にコピー元のファイル名(絶対パス)
・D6に格納先のフォルダ名(絶対パス)
があります。
この条件だけでコピー→格納するコードを教えていただけたら助かります。よろしくお願いします。

投稿日時 - 2008-04-20 16:01:21

QNo.3962445

すぐに回答ほしいです

質問者が選んだベストアンサー

またまた#1です。 (^o^)丿

同名ファイルがあるときは xxxx_01.jpg の形式の連番を付加して別名で保存する
のを考えてみました。(連番は Max10 まで)

ファイル名とコピー先のフォルダパス名にアンダースコア( _ )が付いていない
ことが条件です。

Sub Test2()
 Dim i, OldFile, OldName, FileExt, NewFile, NewName, n, Pos
 i = 6
 Do While Cells(i, 2) <> ""
  On Error Resume Next
  MkDir Cells(6, 4).Value  'コピー先に指定したフォルダがない場合は作成。
  OldFile = Cells(i, 2)
  OldName = Right(OldFile, Len(OldFile) - InStrRev(Cells(i, 2), "\") + 1)
  OldName = Left(OldName, InStrRev(OldName, ".") - 1)
  FileExt = Right(Cells(i, 2), Len(Cells(i, 2)) - InStrRev(Cells(i, 2), ".") + 1)
  NewFile = Cells(6, 4) & OldName & FileExt
  NewName = Left(NewFile, InStrRev(NewFile, ".") - 1)
  If Dir(NewFile) <> "" Then
   For n = 1 To 10
    Pos = InStrRev(NewName, "_")
    If Pos = 0 Then Pos = Len(NewName)
    NewFile = Left(NewName, Pos) & "_" & Format(n, "00") & FileExt
    If Dir(NewFile) = "" Then Exit For
   Next
  End If
  FileCopy OldFile, NewFile
  'Kill OldFile
  i = i + 1
 Loop
End Sub

投稿日時 - 2008-04-21 15:06:02

このQ&Aは役に立ちましたか?

0人が「このQ&Aが役に立った」と投票しています

回答(3)

ANo.2

#1です。

FileCopyを使った場合は、常に上書きになります。

同名ファイルがあった場合、コピー先の既存ファイルに連番をつける
ことは、私にはむずかしかったものですから‥‥。 (^^ゞ

なお、On Error Resume Next は、B列セルに記述されたファイルが
なかった場合に、無視して次の行を処理させるためにつけました。

投稿日時 - 2008-04-21 12:40:54

ANo.1

稚拙ですが――

Sub Test()
 Dim i, OldFile, NewFile
 i = 6
 Do While Cells(i, 2) <> ""
  On Error Resume Next
  OldFile = Cells(i, 2).Value
  NewFile = Cells(6, 4).Value & _
        Right(OldFile, Len(OldFile) - InStrRev(OldFile, "\") + 1)
  i = i + 1
  FileCopy OldFile, NewFile
  ' Kill OldFile  '元ファイルは削除したい場合はこの行を生かします。
 Loop
End Sub

投稿日時 - 2008-04-20 16:40:51

お礼

misatoannaさんありがとうございました。ばっちりでした。
ひとつ質問させていただきたいのですが、

フォルダにファイルをコピーして格納します。
再度同じパスをコピーして格納すると、予想では「すでに同じ名前のファイルがあります・・・」というような表示が現れると思ったのですが、再度同じファイルをフォルダに入れてもそのような表示がありませんでした。On Error Resume Nextかな?と思ってコメントアウトした
のですが、それは関係ないようでした。こうゆうものでしたでしょうか?

投稿日時 - 2008-04-20 17:26:46

あなたにオススメの質問