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