frsm
Active Member
- Joined
- Jun 19, 2006
- Messages
- 258
good time for all of you
this issue is very important for me and we are very near to achive it
i have a workbook will be copied to CD and i want it to work only from the cd and if it in the hard disks or floopy or flash disk to close before working.
by the help of this forum i reached the following code :
in this code it testing the workbook's place and take the drive letter then compare it with the cd's letter if it equal the file will open else it will be closed .
the problem somtimes there are more than one cd in the computer , there this code doesn't recognize which letters we need so it will not work well
the requset to allow the code recognize each CD letter and compare it with the workbook's drive letter if it is equal to one of them to work else to close
thank you
this issue is very important for me and we are very near to achive it
i have a workbook will be copied to CD and i want it to work only from the cd and if it in the hard disks or floopy or flash disk to close before working.
by the help of this forum i reached the following code :
Code:
Option Base 0
Private Sub Workbook_Open()
Dim fso As Object, drv As Object, arrdrvTypes
Dim sdrvName As String, sdrvType As String, sdrvLetter As String
Dim ldrvSize As Long, ldrvFreeSpace As Long, sMsg As String
arrdrvTypes = Array("Unknown", "Removable", "Fixed", "Network", "CD-ROM", "RAM Disk")
Set fso = CreateObject("Scripting.FileSystemObject")
For Each drv In fso.drives
If drv.DriveType = 4 Then
sdrvLetter = drv.DriveLetter
If Left(ActiveWorkbook.Path, 1) <> sdrvLetter Then
ActiveWorkbook.Close
End If
End If
Next
MsgBox "Enjoy your time you have the orginal CD "
End Sub
the problem somtimes there are more than one cd in the computer , there this code doesn't recognize which letters we need so it will not work well
the requset to allow the code recognize each CD letter and compare it with the workbook's drive letter if it is equal to one of them to work else to close
thank you