バックアップ バックアップ(FSO)

VB&VBA
FROG ふろっぐ
 
  • オプション

    本文印刷

    お気に入りに追加

  • 検索

    Googlewwwjp-ia
     

    Googlewwwjp-ia
     
  • 情報

  • 関連

[VB&VBA][バックアップ バックアップ(FSO)]

Sub FileCopy()

On Error GoTo ERROR

Dim MyPath As String
Dim TargetPath As String
Dim blnCheck As Boolean
Dim strChoice As String
Dim Mypractice As Integer
Dim FolderName As String
Dim objFSO As Object

Mytrial:
Set objFSO = CreateObject("Scripting.FileSystemObject") 'FSO定義

MyPath = Application.ActiveWorkbook.Path '現在パス
TargetPath = "\\PCname\c\My Documents\TEST\TEST" '目的のパス

blnCheck = objFSO.Folderexists(TargetPath & "1\") 'フォルダー1の存在を確認

If blnCheck = False Then '無い場合 strchoice
strChoice = MsgBox(TargetPath & " Path無いか、該当フォルダ不明です。もう一度実行しますか?" _
& vbCr & vbCr & "《はい》:この処理を中止します。" _
& vbCr & "《いいえ》:もう一度実行します。", vbYesNo, "ERROR")
Select Case strChoice
Case vbNo '《いいえ》
Set objFSO = Nothing
Exit Sub
Case vbYes '《はい》practice
Set objFSO = Nothing
GoTo Mytrial
End Select
End If

For Mypractice = 1 To 5
FolderName = TargetPath & CStr(Mypractice) & "\"
blnCheck = objFSO.Folderexists(FolderName)
If blnCheck = False Then
objFSO.copyfolder MyPath, TargetPath & CStr(Mypractice)
MsgBox "<<BackUp>>終了", 0, "END"
Set objFSO = Nothing
Exit Sub
End If
Next Mypractice

objFSO.deletefolder TargetPath & "1"
Name TargetPath & "2" As TargetPath & "1"
Name TargetPath & "3" As TargetPath & "2"
Name TargetPath & "4" As TargetPath & "3"
Name TargetPath & "5" As TargetPath & "4"

objFSO.copyfolder MyPath, TargetPath & "5"

Set objFSO = Nothing

MsgBox "<<BackUp>>終了", 0, "END"

Exit Sub

ERROR:
MsgBox "FileCopyを実行中エラー " & Err.Number & " 発生 ", vbCritical, "ERROR"

End Sub





Production Japan Import Application. Since 1998