096045 ランダム
 ホーム | 日記 | プロフィール 【フォローする】 【ログイン】

続・頑張れ!ひろたん!

続・頑張れ!ひろたん!

CD-ROMからコピー(FileSystemObject)

Private Sub コマンド0_Click()
    ' 【参照設定】Microsoft Scripting Runtime
    
    ' 変数定義
    Dim objFSO As FileSystemObject
    Dim objDrive As Object
    Dim objDir As Object
    Dim objFile As Object
    Dim sSRC As String
    Dim sDST As String
    Dim blnExistCD As Boolean       ' CDフラグ
    
    
    ' 初期設定
    blnExistCD = False
    sDST = "D:\tips\"
    
    ' FileSystemObject
    Set objFSO = CreateObject("Scripting.FileSystemObject")
    ' デバイスを参照
    For Each objDrive In objFSO.Drives
        ' CD-ROMドライブ 且つ 読み取り可能の場合
        If objDrive.DriveType = 4 And objDrive.IsReady Then
        
            ' コピー元フォルダを設定
            sSRC = objDrive.DriveLetter & ":\tips"
            
            ' 特定のフォルダが存在する場合、指定の場所にフォルダをコピー
            If objFSO.FolderExists(sSRC) Then
                ' フォルダをコピー
                objFSO.CopyFolder sSRC, sDST
                ' コピーしたファイルの読み取り専用属性を外す
                Set objDir = objFSO.GetFolder(sDST & "\tips")
                For Each objFile In objDir.Files
                    objFile.Attributes = Normal
                Next
                ' フラグをTrue
                blnExistCD = True
                ' 処理を抜ける
                Exit For
            End If
            
        End If
    Next
    
    Set objFile = Nothing
    Set objDir = Nothing
    Set objDrive = Nothing
    Set objFSO = Nothing
    
    If blnExistCD Then
        MsgBox sDST & " にコピーしました。"
    Else
        MsgBox "適切なCD-ROMが見つかりません。"
    End If
End Sub


© Rakuten Group, Inc.