[AccessD] Track PC Number

Sorry bout that. 


John W. Colby
Colby Consulting
www.ColbyConsulting.com 
-----Original Message-----
From: accessd-bounces at databaseadvisors.com
[mailto:accessd-bounces at databaseadvisors.com] On Behalf Of John Skolits
Sent: Tuesday, June 12, 2007 1:16 PM
To: 'Access Developers discussion and problem solving'
Subject: Re: [AccessD] Track PC Number

Actually, the "End Function" wasn't on a separate line.

Here it is again.

------------------


Function lbf_GetFirstHardDriveInfo(strType As String) As Variant

  ''*******************************************************
''                         Procedure Identification
''---------------------------------------------------------
''    Name:         lbf_GetFirstHardDriveInfo
''
''    Purpose:  Retrieves info on the hard drive
''
''    Options:  "FreeSpace", "FileSystem", "SerialNumber"
''          "TotalSize", "VolumeName"
''
''    Notes:
''
''
''    Date/Author:   01/20/03 John Skolits
''***********************************************************

On Error GoTo lbf_GetFirstHardDriveInfo_ERR

'*********BEGIN CODE HERE ********
Dim fs, a, pdrive, pMachineID
Set fs = CreateObject("Scripting.FileSystemObject")
 For Each pdrive In fs.Drives
     If pdrive.DriveType = 2 Then
         Select Case strType

             Case "FreeSpace"
                 lbf_GetFirstHardDriveInfo = _
                    Format(CDbl((pdrive.FreeSpace)), "#,###,###")
             Case "FileSystem"
                 lbf_GetFirstHardDriveInfo = _
                    CStr((pdrive.FileSystem))
             Case "SerialNumber"
                 lbf_GetFirstHardDriveInfo = _
                    CStr(Hex(pdrive.SerialNumber))
             Case "TotalSize"
                 lbf_GetFirstHardDriveInfo = _
                    CDbl((pdrive.TotalSize))
             Case "VolumeName"
                 lbf_GetFirstHardDriveInfo = _
                    CStr((pdrive.VolumeName))
          End Select
     End If
 Next
    

lbf_GetFirstHardDriveInfo_EXIT:

Exit Function

lbf_GetFirstHardDriveInfo_ERR:       'Display the error
      
Dim strCallingObject As String
      strCallingObject = "lbf_GetFirstHardDriveInfo" _
      & "  " & Application.CurrentObjectName
      MsgBox Err, Error, strCallingObject
      Resume lbf_GetFirstHardDriveInfo_EXIT 
End Function





--
AccessD mailing list
AccessD at databaseadvisors.com
http://databaseadvisors.com/mailman/listinfo/accessd
Website: http://www.databaseadvisors.com