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

  • 質問

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

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

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

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

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

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

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

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

    2014年8月19日 7:30

回答

  • マクロを実行している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!)

    • 回答としてマーク sakuraxx 2014年8月27日 8:05
    2014年8月19日 17:48

すべての返信

  • マクロを実行している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!)

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

    2014年8月20日 11:56
  • すみません、コードからコメントが抜けてました。

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


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

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

    2014年8月21日 4:18