[[20090709221114]]　『フォルダーのコピー』（habsburg）　ページの最後に飛ぶ

 『フォルダーのコピー』（habsburg）
 コピーするフォルダー（フォルダーの中身は４０個くらいのフォルダーがあります）を 
 選んで違うサーバーを（バックアップサーバー）選んで 
 コピーをするマクロを作りたいのですが教えてください。

 マクロボタンを押したらコピーをするフォルダーを選んで 
 コピー先（違うサーバー）を選んでコピーをし、 
 コピーしたフォルダーに名前をつけるといった感じです。

 フォルダのコピーは、FSO（File System Object）のCopyFolder メソッドを使えば可能です。
 まず、このFSOについてHelpやサイト検索を行って良く調べてください。

 ユーザーインターフェースは、以下の仕様でいかがですか？

 新規ブックにて、ユーザ-フォームを一つ作成してください（UserForm1）。
 中のコントロールは、コードで配置しますから、何も配置しないでください。

 標準モジュールに当該ユーザーフォームを表示するコード

 '====================================================================
 Sub sample()
    UserForm1.Show
 End Sub

 作成したUserForm1のモジュールに

 '====================================================================
 Option Explicit
 Private lblcpynm As MSForms.Label
 Private txtcpynm As MSForms.TextBox
 Private WithEvents cmdref1 As MSForms.CommandButton
 Private WithEvents cmdref2 As MSForms.CommandButton
 Private WithEvents cmdexec As MSForms.CommandButton
 '====================================================================
 Private Sub UserForm_Initialize()
    With Me
       .Width = 516
       .Height = 189.75
       .Caption = "フォルダのコピー"
       Set lblcpynm = .Controls.Add("Forms.Label.1", , True)
       With lblcpynm
          .Caption = ""
          .Left = 126
          .Top = 36
          .Width = 324
          .Height = 18
          .BackColor = &H80000009
          .SpecialEffect = 2
          .Font.Size = 14
       End With
       Set cmdref1 = .Controls.Add("Forms.CommandButton.1", , True)
       With cmdref1
          .Caption = "参照"
          .Left = 450
          .Top = 36
          .Width = 48
          .Height = 18
          .Font.Size = 9
          .TabStop = False
       End With
       Set txtcpynm = .Controls.Add("Forms.TextBox.1", , True)
       With txtcpynm
          .Left = 126
          .Top = 84
          .Width = 324
          .Height = 18
          .Font.Size = 14
          .TabStop = False
          .SelectionMargin = False
       End With
       Set cmdref2 = .Controls.Add("Forms.CommandButton.1", , True)
       With cmdref2
          .Caption = "参照"
          .Left = 450
          .Top = 84
          .Width = 48
          .Height = 18
          .Font.Size = 9
          .TabStop = False
       End With
       Set cmdexec = .Controls.Add("Forms.CommandButton.1", , True)
       With cmdexec
          .Caption = "コピー実行"
          .Left = 18
          .Top = 126
          .Width = 84
          .Height = 30
          .Font.Size = 9
          .TabStop = False
       End With
      With .Controls.Add("Forms.Label.1", , True)
          .Left = 18
          .Top = 36
          .Width = 108
          .Height = 18
          .BackColor = &HFFFF00
          .SpecialEffect = 2
          .Caption = "コピー元フォルダ"
          .Font.Size = 14
       End With
       With .Controls.Add("Forms.Label.1", , True)
          .Left = 18
          .Top = 84
          .Width = 108
          .Height = 18
          .BackColor = &HFFFF00
          .SpecialEffect = 2
          .Caption = "コピー先フォルダ"
          .Font.Size = 14
       End With
    End With
 End Sub
 '====================================================================
 Private Sub cmdref1_Click()
    Dim ffname As Variant
    ffname = get_folder_path("コピー元フォルダを選択して下さい")
    If TypeName(ffname) <> "Boolean" Then
       lblcpynm.Caption = ffname
    End If
 End Sub
 '====================================================================
 Private Sub cmdref2_Click()
    Dim ffname As Variant
    Dim cpynm As Variant
    ffname = get_folder_path("コピー先フォルダを選択して下さい")
    If TypeName(ffname) <> "Boolean" Then
       cpynm = Split(lblcpynm, "\")
       If Right(ffname, 1) <> "\" Then ffname = ffname & "\"
       txtcpynm.Value = ffname & cpynm(UBound(cpynm))
    End If
 End Sub
 '====================================================================
 Function get_folder_path(mes, Optional ByVal opt As Variant = 1)
    Dim fld  As Object
    Set fld = CreateObject("Shell.Application").BrowseForFolder(0, mes, opt, 0)
    On Error Resume Next
    If Not fld Is Nothing Then
       get_folder_path = fld.items.Item.Path
       If Err.Number <> 0 Then
          get_folder_path = False
          End If
    Else
       get_folder_path = False
       End If
 End Function
 '====================================================================
 '====================================================================
 '====================================================================
 Private Sub cmdexec_Click()
 ' ここにフォルダのコピー処理を記述する
 End Sub
 '====================================================================
 '====================================================================

 これで、sampleを実行してみてください。

 ユーザーフォームが表示されます。
 コピー元フォルダの右端にある参照ボタンをクリックしてください。
 フォルダ選択ダイアログが表示されますので、コピー元のフォルダを選択して下さい。
 ＯＫボタンで左隣のボックス（実際はラベル）にフォルダ名が表示されます。
 この時、フォルダパスが長すぎて表示し切れなくてもデータは正しく設定されています。

 次にコピー先フォルダの右端にある参照ボタンをクリックしてください。
 コピー元フォルダの右端にある参照ボタンをクリックしてください。
 同じようにフォルダ選択ダイアログが表示されますので、コピー先のフォルダを選択して下さい。
 ＯＫボタンで左隣のテキストボックスには、

 選択されたフォルダ名＋コピー元のフォルダ名の最後の構成要素

 が表示されます。
 コピー先のフォルダパスに変更があるなら直接変更も可能です。

 コピー元フォルダ及び、コピー先フォルダが決定したら、コピー実行ボタンをクリックしてください。
 フォルダコピーが行なわれます。
(実際のコピーのコードは記述していませんから、御自分で調べてみてください）

 ファイルＩ／Ｏは、ＦＳＯでかなりのことができますが、使い方を間違えると
 データを消してしまう可能性もありますから、十分にFSOについてテストを行なった後、運用してください。

 ichinose

 ichinoseさん、ありがとうございました。
 がんばって試してみます。
 （habsburg）

コメント返信：

[ 一覧(最新更新順) ]

[[20090709221114]] 『フォルダーのコピー』（habsburg） ページの最後に飛ぶ

[[20090709221114]]　『フォルダーのコピー』（habsburg）　ページの最後に飛ぶ