Link to home
Start Free TrialLog in
Avatar of dmorse03
dmorse03

asked on

How determine what CD drive user has selected?

I am putting an Excel file on a CD for distribution to several people. One application requires coding to create an absolute link to a file on the CD in the drive in which the user has inserted the CD. eg:

The file is, say:  232.tif
This user's drive is G:\
need coding to determine that the drive is G so that I can create link:
G:\232.tif
Avatar of EDDYKT
EDDYKT
Flag of Canada image

Private Sub Command1_Click()
Debug.Print Mid(App.Path, 1, 3) & "232.tif"
End Sub
To create short cut


Option Explicit

Enum ShortCutDest
  DeskTop
  Programs
  StartMenu
  StartUp
End Enum

Public Function CreateLink(dest As ShortCutDest, ByVal sName As String, ByVal sPath As String, Optional HotKey As String = "", Optional sIcon As String = "", Optional sWorkingDirectory As String = "", Optional sSubFolder As String = "", Optional WinStyle As Integer = vbNormalFocus)
 Dim WshShell As Object
 Dim oShellLink As Object
 Dim sLinkPath As String
 Set WshShell = CreateObject("WScript.Shell")
 Select Case dest
     Case DeskTop
          sLinkPath = WshShell.SpecialFolders("Desktop")
     Case StartMenu
          sLinkPath = WshShell.SpecialFolders("StartMenu")
     Case StartUp
          sLinkPath = WshShell.SpecialFolders("StartUp")
     Case Programs
          sLinkPath = WshShell.SpecialFolders("Programs")
 End Select
 On Error Resume Next
 If sSubFolder <> "" Then
    sLinkPath = sLinkPath & "\" & sSubFolder
    If Dir(sLinkPath) = "" Then MkDir sLinkPath
 End If
 On Error GoTo 0
 Set oShellLink = WshShell.CreateShortCut(sLinkPath & "\" & sName & ".lnk")
 oShellLink.WindowStyle = WinStyle
 oShellLink.HotKey = sHotKey
 oShellLink.TargetPath = sPath
 oShellLink.IconLocation = sIcon
 oShellLink.Description = sName
 oShellLink.WorkingDirectory = sWorkingDirectory
 oShellLink.Save
 Set oShellLink = Nothing
 Set WshShell = Nothing
End Function

'Usage
Private Sub Command1_Click()
 CreateLink DeskTop, "Calculator", "c:\windows\calc.exe", "CTRL+SHIFT+C", "calc.exe,0", "c:\windows"
 CreateLink StartMenu, "Calculator", "c:\windows\calc.exe", "CTRL+SHIFT+C", "calc.exe,0", "c:\windows"
 CreateLink StartUp, "Calculator", "c:\windows\calc.exe", "CTRL+SHIFT+C", "calc.exe,0", "c:\windows"
 CreateLink Programs, "Calculator", "c:\windows\calc.exe", "CTRL+SHIFT+C", "calc.exe,0", "c:\windows", "WinCalc"
 CreateLink Programs, "Calculator Help", "c:\windows\help\calc.hlp", "", "winhlp32.exe,0", "c:\windows\help", "WinCalc"
 CreateLink Programs, "Visit our web site", "https://www.experts-exchange.com", , "shdocvw.dll,0", , "WinCalc", vbMaximizedFocus
End Sub
Avatar of DrTech
DrTech

App.Path gives you the path where the application was run from.
Try this code

Function ShowDriveType
   Dim fso, d, dc, s, n
   Set fso = CreateObject("Scripting.FileSystemObject")
   Set dc = fso.Drives
   For Each d in dc
      if d.drivetype = 4 then exit for
   Next
   ShowDriveType = d.driveletter
End Function


msgbox showdrivetype
iozturk: What if the user has more than one cd-rom drive (for instance I have). Then you are not sure to get the right one!
DrTech: What if application is in HDD and 232.tif is in CD? Then you are not sure you are getting right one:)
But my code can be extended as

Function ShowDriveType
  Dim fso, d, dc, s, n
  dim flag as boolean
  Set fso = CreateObject("Scripting.FileSystemObject")
  Set dc = fso.Drives
   
  flag=false
For Each d in dc
     if d.drivetype = 4 then
        if fso.fileexists (d.drivename & ":\232.tif") then exit for
        flag=true
     end if
     
Next

if flag=true then
   ShowDriveType = d.driveletter
else
   ShowDriveType = "Cannaot find correct drive"
end if


OK?
Agree! But the way I read the question, the application is run from the cd.

dmorse03, please clarify!
There is a typo! Pls. try this

Function ShowDriveType
 Dim fso, d, dc, s, n
 dim flag as boolean
 Set fso = CreateObject("Scripting.FileSystemObject")
 Set dc = fso.Drives
 
 flag=false
For Each d in dc
    if d.drivetype = 4 then
       if fso.fileexists (d.drivename & ":\232.tif") then
          flag=true
          exit for
        end if
    end if
   
Next

if flag=true then
  ShowDriveType = d.driveletter
else
  ShowDriveType = "Cannaot find correct drive"
end if
End Function
Avatar of dmorse03

ASKER

When executing this line:

if fso.fileexists (d.drivename & ":\232.tif") then

I get this error:

Run Time error '438'
Object doesn't support this property or method

^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
I could put the entire Excel file on web storage for you to examine, but it is 930 Kb!
Incidently, yes the Excel file and all the fotos will be on CD. Also, most of the people who will be using this will use D:\ as the CD drive. But some will not. My Cd drives, for instance, are J:\ and K:\.

Sorry change d.drivename  to d.driveletter
ASKER CERTIFIED SOLUTION
Avatar of DrTech
DrTech

Link to home
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
Start Free Trial

Quote:
--------------------------------------------------------------------------------
Originally Posted by Iceplug
So, if you are running from the Excel macro, then
Application.ActiveWorkbook.Path hopefully gives you the path of your workbook... and you can substitute this for the App.Path that OnErr0r mentioned.
--------------------------------------------------------------------------------


^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
I owe you big time. I have been on this project since last June. Many forums have helped me but you supplied the final link I needed to finish it. So simple (if you know what you are doing). I now have 600+ family fotos on CD along with an Excel control program to allow the user to create a list of fotos per his criteria (Aunt Jane, eg) and run this list as a slideshow (your link).
Don
Cortland, NY
I originally posted this question. There is a wealth of information here. But the method I finally chose was from another source. The post is listed as "unlocked". I do not know how to close it out under the circumstances as I did not actually use any of the answers herein. But I do appreciate all the response I got here.
What solution did you use?
This is the suggestion I was given:

Application.ActiveWorkbook.Path

This is my final coding:

FindDrive:

   DriveID = Application.ActiveWorkbook.Path
     Range("U5").Select    'Select your first data cell
      Do Until ActiveCell.Value = ""
        ActiveCell.Value = DriveID & "\" & ActiveCell.Value & ".tif"        'Grab current value of the cell, Show path, append '.TIF', & replace it
       ActiveCell.Offset(1, 0).Select  'Move to next cell
     Loop