VBA コピーするが両方のファイルを保持する

Question

Windows7(Excel2010)を運用しています。

例えば「D:\TEMP」フォルダに「Book001.xlsx」ファイルが存在しているとします。

他のフォルダに有る同名の「Book001.xlsx」ファイルを「D:\TEMP」フォルダへコピーします。

その際、ダイアログに表示される３通りから

『コピーするが両方のファイルを保持する』を選択した場合の処理についてですが、

これと同様の事を、「Book001.xlsx」を開いてマクロで実行したいのですが、

例えば「Workbook.SaveCopyAs メソッド」に引数などを定義する方法は有るのでしょうか？

VBAコードのご教授よろしくお願いします。

Answer 1

マクロを実行しているEXCELファイルと無関係なファイルをコピーしたいのであれば、

Option Explicit

Sub Macro1()
    Call FileCopyOrRenameCopy("D:\Temp2\Book001.xlsx", "D:\Temp")
End Sub

Sub FileCopyOrRenameCopy(ByVal sourceFilePath As String, ByVal targetFolderPath As String, Optional ByVal isShowDialog As Boolean = True)
    Dim fso As New Scripting.FileSystemObject 'Microsoft Scripting Runtime
    If Not (fso.FileExists(sourceFilePath)) Then
        Exit Sub
    End If
    If Not (fso.FolderExists(targetFolderPath)) Then
        Exit Sub
    End If
    
    Dim file As Scripting.file
    Set file = fso.GetFile(sourceFilePath)

    Dim folderPath As String
    Dim fileName As String
    folderPath = file.ParentFolder.Path
    fileName = file.Name

    Dim shell As New Shell32.shell 'Microsoft Shell Controls And Automation
    Dim folderSource As Shell32.Folder '元ファイルのフォルダ
    Dim folderDestination As Shell32.Folder 'コピー先フォルダ
    Dim fileSource As Shell32.FolderItem 'コピーするアイテム(フォルダやファイル)

    Set folderSource = shell.Namespace(folderPath)
    Set fileSource = folderSource.Items.Item(fileName)

    Set folderDestination = shell.Namespace(targetFolderPath)
    If (isShowDialog) Then
        Call folderDestination.CopyHere(fileSource, 0)'ファイルが既にあればダイアログが表示
    Else
        Call folderDestination.CopyHere(fileSource, 8)'ファイルが既にあれば自動でファイル名を変更
    End If
End Sub

CopyHereのパラメータについての説明はここかな？
自動でファイル名が変更される場合でもOSやOSの言語によって変化してしまいます。ダイアログで保持するを選んだ場合とは異なる名前が付いてしまいます。ダイアログの場合と同じ名前にしたい場合はファイル名を自分で決めてコピーするしかないです。

---

個別に明示されていない限りgekkaがフォーラムに投稿したコードにはフォーラム使用条件に基づき「MICROSOFT LIMITED PUBLIC LICENSE」が適用されます。(かなり自由に使ってOK!)

Answer 2

gekkaさん、回答有難うございます。
早速、Windows7(32bit),Excele2010(32bit)の標準モジュールへ提示いただいたサンプルコードをコピー張付けし試行したのですが、
-------------------------------------------
コンパイルエラー
ユーザー定義型は定義されていません。
-------------------------------------------
Dim FSO As New Scripting.FileSystemObject 'Microsoft Scripting Runtime
が発生します。非力な私には解決することができません…ヘルプ

Answer 3

すみません、コードからコメントが抜けてました。

VBAのメニューにあるツール->参照設定で、「Microsoft Scripting Runtime」と「Microsoft Shell Controls And Automation」の参照を追加してください。

---

個別に明示されていない限りgekkaがフォーラムに投稿したコードにはフォーラム使用条件に基づき「MICROSOFT LIMITED PUBLIC LICENSE」が適用されます。(かなり自由に使ってOK!)

Answer 4

gekkaさん、大変お世話になっております。
参照設定をする事でコンパイルエラーは回避できました…感謝。
勿論、試行結果はOKでした。
ご多忙のところご教授有難うございました。