[AccessD] Where is the Zip Drive?

  running sub checkavailabledrives should indicate
a zip drive as a "Removable drive." and its path
like so

Path A:\ Drive Type Floppy drive.
Path C:\ Drive Type Hard drive; can not be removed.
Path D:\ Drive Type CD-ROM drive.
Path E:\ Drive Type Hard drive; can not be removed.


Public Declare Function GetLogicalDriveStrings Lib "kernel32" _
Alias "GetLogicalDriveStringsA" _
(ByVal nBufferLength As Long, _
ByVal lpBuffer As String) As Long
Public Declare Function GetDriveType Lib "kernel32" _
Alias "GetDriveTypeA" _
(ByVal nDrive As String) As Long

'drive type constants
Public Const DRIVE_REMOVABLE As Long = 2
Public Const DRIVE_FIXED As Long = 3
Public Const DRIVE_REMOTE As Long = 4
Public Const DRIVE_CDROM As Long = 5
Public Const DRIVE_RAMDISK As Long = 6

Public Sub CheckAvailableDrives()

Dim lpBuffer As String

'get list of available drives
lpBuffer = GetDriveString()

'Separate the drive strings
'and add to the combo. StripNulls
'will continually shorten the
'string. Loop until a single
'remaining terminating null is
'encountered.
Do Until lpBuffer = Chr$(0)
Dim strDrive As String
'strip off one drive item
'and add to the combo
strDrive = StripNull(lpBuffer)
Debug.Print "Path " & strDrive & " Drive Type " & rgbGetDriveType(strDrive)

Loop

End Sub
Private Function rgbGetDriveType(RootPathName As String) As String

'returns the type of drive.

Select Case GetDriveType(RootPathName)
Case 0: rgbGetDriveType = "The drive type cannot be determined."
Case 1: rgbGetDriveType = "The root directory does not exist."

Case DRIVE_REMOVABLE:
Select Case Left(RootPathName, 1)
Case "a", "b": rgbGetDriveType = "Floppy drive."
Case Else: rgbGetDriveType = "Removable drive."
End Select

Case DRIVE_FIXED: rgbGetDriveType = "Hard drive; can not be removed."
Case DRIVE_REMOTE: rgbGetDriveType = "Remote (network) drive."
Case DRIVE_CDROM: rgbGetDriveType = "CD-ROM drive."
Case DRIVE_RAMDISK: rgbGetDriveType = "RAM disk."
End Select

End Function

Public Function GetDriveString() As String

'returns string of available
'drives each separated by a null
Dim sBuffer As String

'possible 26 drives, three characters each, plus trailing null
sBuffer = Space$(26 * 4)

If GetLogicalDriveStrings(Len(sBuffer), sBuffer) Then

'do not trim off trailing null!
GetDriveString = Trim$(sBuffer)

End If

End Function
Function StripNull(startStrg As String) As String

'Take a string separated by Chr(0)'s, and split off 1 item, and
'shorten the string so that the next item is ready for removal.

Dim pos As Integer
pos = InStr(startStrg, Chr$(0))

If pos Then
StripNull = Mid(startStrg, 1, pos - 1)
startStrg = Mid(startStrg, pos + 1, Len(startStrg))
End If

End Function



Chris Enright wrote:

>The little I know about VBA I got from this site. Every day I read every email! Eighty percent goes right over my head! But the little I have understood from AccessD makes me a living. J
>   
>  I have a program that the customer loves. He keeps opening new branches and, because he is slightly computer literate (and therefore dangerous), he happily installs FE and, a BE with blank tables, on each new PC.
>   
>  Unfortunately, the people who supply the PCs to him configure them differently each time they supply one.
>   
>  My program is designed so that, at close down, it will backup the BE to an Iola Zip Disk. This is normally E:. (Based on A: Floppy, B: (showing your age), C: Hard Disk, D: CD/DVD.)
>   
>  However, sometimes there seem to be all sorts of odd drives, even phantom disk partitions and the Zip Drive isn’t where I programmed it.
>   
>  The customer LOVES going in to my FE and sorting it out! Inevitably I then spend hours (because he didn’t tell me what he had done) tracking down a problem on a new installation.
>   
>  Below is my, very crude, (please don’t laugh, it normally works), backup function. Could someone please correct it, either to the list or offline, so that it will detect where the Zip Disk is?
>   
>  TIA
>   
>  Chris
>   
>  {Oh I am embarrassed about showing my code to you lot}
>   
>  ----------------------------------------------------------------------------------
>   
>  Private Function Backup()
>   
>      Dim strNewDBName As String
>      Dim strOldDbName As String
>      Dim fso
>      Dim file As String
>      Dim msg As String
>      
>  On Error GoTo Err_Backup
>                  
>      DoCmd.Hourglass True
>      
>          ' copy database
>          strOldDbName = "C:\Startan\Startan BE.mdb"
>          strNewDBName = "D:\BuExp.mdb"
>          FileCopy strOldDbName, strNewDBName
>                              
>          ' if a previous backup exists then delete it
>          file = "D:\StartanBU.mdb"
>          Set fso = CreateObject("Scripting.FileSystemObject")
>          If fso.FileExists(file) Then
>              fso.DeleteFile file, True
>          End If
>               
>          ' rename backup database
>          Name strNewDBName As file
>          
>      DoCmd.Hourglass False
>          
>  Exit_Backup:
>      Exit Function
>   
>  Err_Backup:
>      msg = "Make sure the Zip Disk is in the computer " '& Chr(10)
>      msg = msg & "and that the drive lights have stopped flashing "
>      msg = msg & "and then press Enter"
>      MsgBox msg
>      Resume
>      
>  End Function
>     
>
>  
>   
>  Still blushing, going for a drink!!
>   
>   
>  Chris
>   
>
> 		
>---------------------------------
>Stay in the know. Pulse on the new Yahoo.com.  Check it out. 
>  
>

-- 
Marty Connelly
Victoria, B.C.
Canada