質問をすることでしか得られない、回答やアドバイスがある。

15分調べてもわからないことは、質問しよう!

新規登録して質問してみよう
ただいま回答率
86.12%
VBA

VBAはオブジェクト指向プログラミング言語のひとつで、マクロを作成によりExcelなどのOffice業務を自動化することができます。

解決済

フォルダを統合した時に同名ファイルが有った場合、「同名のファイルが有ります・・・。」というメッセージボックスを表示させたい。

ice930
ice930

総合スコア91

VBA

VBAはオブジェクト指向プログラミング言語のひとつで、マクロを作成によりExcelなどのOffice業務を自動化することができます。

2回答

0グッド

0クリップ

233閲覧

投稿2022/11/12 11:37

前提

以下のコードを使って、2つのフォルダを統合し、追加したデータをフォルダごと「追加データ」というフォルダに移動しています。
エラー等はなく正常に作動するのですが、同名のファイルが有った場合に自動で上書き保存されてしまいます。

実現したいこと

同名のファイルが有った場合に「同名のファイルがあります・・・。」の表記が表示される。
又は「ファイル名(1)」の様に自動で名前を変えて保存したい。
若しくは同名のファイルが有った場合は移動しない。

試したこと

Do while や for文等を使い、ファイルを循環させれば実現可能なのですが、そもそもVBA上でエクセルを保存する時の様に、上書きする際に、「fso.CopyFolder」の設定等を指定出来ないかと思い質問致しました。

ちなみに主導でフォルダをドラッグ&ドロップすると、「同名のファイルが存在します・・・」というメッセージが表示され、上書き「置き換え」するか選択できます。

以下がそのコードです。下から5行目に「fso.CopyFolder」を使っております。

よろしくお願いします。

Sub データ上書き() Set fso = CreateObject("Scripting.FileSystemObject") adname = "初期値" Row = 6 Do While adname <> "" adname = Cells(Row, 2) & "\" & Cells(Row, 1) addit = ThisWorkbook.Path & "\追加データ" & "\" & Cells(Row, 1) If adname = "\" Then Exit Do End If b = fso.FolderExists(adname) c = fso.FolderExists(addit) If b = False Then MsgBox "注意!!!移動先(重要データ)のフォルダが有りません。" & Cells(Row, 1) & "のURLを確認して下さい。" End ElseIf c = False Then MsgBox Cells(Row, 1) & "の追加データが存在しません。" End End If fso.CopyFolder addit, adname '異動済みフォルダ lastfol = ThisWorkbook.Path & "\過去追加データ" & "\" & Format(Date, "yyyymmdd") b = fso.FolderExists(lastfol) If b = False Then 'ファイル無かったら移動 MkDir lastfol fso.MoveFolder addit, lastfol & "\" & Cells(Row, 1) Else 'フォルダが有ったらコピー&削除 fso.CopyFolder addit, lastfol & "\" & Cells(Row, 1) fso.deletefolder addit End If Row = Row + 1 Loop End Sub

以下のような質問にはグッドを送りましょう

  • 質問内容が明確
  • 自分も答えを知りたい
  • 質問者以外のユーザにも役立つ

グッドが多くついた質問は、TOPページの「注目」タブのフィードに表示されやすくなります。

気になる質問をクリップする

クリップした質問は、後からいつでもマイページで確認できます。

またクリップした質問に回答があった際、通知やメールを受け取ることができます。

下記のような質問は推奨されていません。

  • 間違っている
  • 質問になっていない投稿
  • スパムや攻撃的な表現を用いた投稿

適切な質問に修正を依頼しましょう。

回答2

1

  1. 片方のフォルダのファイルリストを取得
  2. ファイル名を取り出し、もう片方にそのファイルが存在しているかをチェック
  3. 存在している場合はダイアログを出し、確認
  4. ファイルのコピー
  5. ファイルが尽きるまで2から繰り返し

という実装になるかと。

投稿2022/11/12 13:33

y_waiwai

総合スコア86013

BeatStar👍を押しています

良いと思った回答にはグッドを送りましょう。
グッドが多くついた回答ほどページの上位に表示されるので、他の人が素晴らしい回答を見つけやすくなります。

下記のような回答は推奨されていません。

  • 間違っている回答
  • 質問の回答になっていない投稿
  • スパムや攻撃的な表現を用いた投稿

このような回答には修正を依頼しましょう。

0

ベストアンサー

CopyFolder の第3引数にFalseを設定すると上書きされません。同名のファイルが存在するときはエラーが発生します。(詳細は下記参照)

CopyFolder メソッド (Visual Basic for Applications) | Microsoft Learn

同名のファイルが有った場合に「同名のファイルがあります・・・。」の表記が表示される。
又は「ファイル名(1)」の様に自動で名前を変えて保存したい。
若しくは同名のファイルが有った場合は移動しない。

「同名のファイルが有った場合は移動しない」でいいのなら、エラーが出たら、エラーを無視して次の処理に進むようにすればいいでしょう。

vba

1 'フォルダが有ったらコピー&削除 2 On Error Resume Next 3 fso.CopyFolder addit, lastfol & "\" & Cells(Row, 1) 4 If Err.Number = 58 Then 5 MsgBox "同名ファイルがあるのでコピーできません。" & vbCrLf & _ 6 "コピー元:" & addit & vbCrLf & _ 7 "コピー先:" & lastfol & "\" & Cells(Row, 1) 8 Err.Clear 9 Else 10 fso.deletefolder addit 11 End If 12 On Error Goto 0

「「ファイル名(1)」の様に自動で名前を変えて保存したい」のなら、1ファイルずつコピーして、同名ファイルが存在するときは、名前を変更してコピーするようにすればいいでしょう。

フォルダー内のファイルは Filesプロパティで取得できます。

FileSystemObject:フォルダ内のすべてのファイルを取得(Files プロパティ) | ExcelWork.info

ファイルのコピーはCopyFile メソッドで。
FileSystemObject:ファイルをコピー(CopyFile メソッド) | ExcelWork.info

同名ファイルの存在は、FileExists メソッドで。
FileSystemObject:ファイルの存在確認(FileExists メソッド) | ExcelWork.info

投稿2022/11/13 04:54

hatena19

総合スコア32005

良いと思った回答にはグッドを送りましょう。
グッドが多くついた回答ほどページの上位に表示されるので、他の人が素晴らしい回答を見つけやすくなります。

下記のような回答は推奨されていません。

  • 間違っている回答
  • 質問の回答になっていない投稿
  • スパムや攻撃的な表現を用いた投稿

このような回答には修正を依頼しましょう。

15分調べてもわからないことは
teratailで質問しよう!

ただいまの回答率
86.12%

質問をまとめることで
思考を整理して素早く解決

テンプレート機能で
簡単に質問をまとめる

質問する

関連した質問

同じタグがついた質問を見る

VBA

VBAはオブジェクト指向プログラミング言語のひとつで、マクロを作成によりExcelなどのOffice業務を自動化することができます。