Reply
 
LinkBack Thread Tools Search this Thread Display Modes
  #1   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 1
Default How do I obtain the drive serial number in EXCEL spreadsheet

How can I obtain the serial number of a drive that a spreadsheet is
installed on from within the same EXCEL spreadsheet?
  #2   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 226
Default How do I obtain the drive serial number in EXCEL spreadsheet

Try:

Sub DriveSerial()

Dim fs As Object
Dim d As Object

Set fs = CreateObject("Scripting.FileSystemObject")
Set d = fs.GetDrive(fs.GetDriveName _
(fs.GetAbsolutePathName(ThisWorkbook.Path)))
MsgBox d.SerialNumber

End Sub

Hope this helps
Rowan

"Paul Ramirez" wrote:

How can I obtain the serial number of a drive that a spreadsheet is
installed on from within the same EXCEL spreadsheet?

  #3   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 11,272
Default How do I obtain the drive serial number in EXCEL spreadsheet

A couple of ways (to get different answers :-))


'Using FSO

Function DiskVolumeId(Drive As String) As String
Dim FSO As Object
Set FSO = CreateObject("Scripting.FileSystemObject")
DiskVolumeId = Format(CDbl(FSO.Drives(Drive).SerialNumber))
End Function


'Using API

Declare Function GetVolumeInformation Lib "kernel32" _
Alias "GetVolumeInformationA" _
(ByVal lpRootPathName As String, _
ByVal lpVolumeNameBuffer As String, _
ByVal nVolumeNameSize As Long, _
lpVolumeSerialNumber As Long, _
lpMaximumComponentLength As Long, _
lpFileSystemFlags As Long, _
ByVal lpFileSystemNameBuffer As String, _
ByVal nFileSystemNameSize As Long) As Long



Function DriveiD(Drive As String)
Const cMaxPath As Long = 256
Dim nTemp
Dim sTemp As String
Dim nRet As Long
Dim nVolSerial As Long
Dim sVolName As String * cMaxPath
Dim nMaxCompLen As Long
Dim nFileSysFlags As Long
Dim sFileSysName As String * cMaxPath

If Right(Drive, 1) < "\" Then Drive = Drive & "\"
nRet = GetVolumeInformation(Drive, sVolName, cMaxPath, _
nTemp, nMaxCompLen, nFileSysFlags, _
sFileSysName, cMaxPath)
sTemp = Format(Hex(nTemp), "00000000")
sTemp = Left(sTemp, 4) & "-" & Right(sTemp, 4)


DriveiD = sTemp
End Function


--

HTH

RP
(remove nothere from the email address if mailing direct)


"Paul Ramirez" wrote in message
m...
How can I obtain the serial number of a drive that a spreadsheet is
installed on from within the same EXCEL spreadsheet?



  #4   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 214
Default How do I obtain the drive serial number in EXCEL spreadsheet

Hi Bob,
If you agree, I prefer:

Function DiskVolumeId(Drive As String) As String
DiskVolumeId = Hex(CreateObject("Scripting.FileSystemObject") _
..Drives.Item(CStr(Drive)).SerialNumber)
End Function

MP

"Bob Phillips" a écrit dans le message
de news: ...
A couple of ways (to get different answers :-))


'Using FSO

Function DiskVolumeId(Drive As String) As String
Dim FSO As Object
Set FSO = CreateObject("Scripting.FileSystemObject")
DiskVolumeId = Format(CDbl(FSO.Drives(Drive).SerialNumber))
End Function


'Using API

Declare Function GetVolumeInformation Lib "kernel32" _
Alias "GetVolumeInformationA" _
(ByVal lpRootPathName As String, _
ByVal lpVolumeNameBuffer As String, _
ByVal nVolumeNameSize As Long, _
lpVolumeSerialNumber As Long, _
lpMaximumComponentLength As Long, _
lpFileSystemFlags As Long, _
ByVal lpFileSystemNameBuffer As String, _
ByVal nFileSystemNameSize As Long) As Long



Function DriveiD(Drive As String)
Const cMaxPath As Long = 256
Dim nTemp
Dim sTemp As String
Dim nRet As Long
Dim nVolSerial As Long
Dim sVolName As String * cMaxPath
Dim nMaxCompLen As Long
Dim nFileSysFlags As Long
Dim sFileSysName As String * cMaxPath

If Right(Drive, 1) < "\" Then Drive = Drive & "\"
nRet = GetVolumeInformation(Drive, sVolName, cMaxPath, _
nTemp, nMaxCompLen, nFileSysFlags, _
sFileSysName, cMaxPath)
sTemp = Format(Hex(nTemp), "00000000")
sTemp = Left(sTemp, 4) & "-" & Right(sTemp, 4)


DriveiD = sTemp
End Function


--

HTH

RP
(remove nothere from the email address if mailing direct)


"Paul Ramirez" wrote in message
m...
How can I obtain the serial number of a drive that a spreadsheet is
installed on from within the same EXCEL spreadsheet?





  #5   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 11,272
Default How do I obtain the drive serial number in EXCEL spreadsheet

Hi Michel,

It certainly looks good to me. Maybe, just to allow for any type of input
(C, C:, C:\, C:\myDir, etc.)

Function DiskVolumeId(Drive As String) As String
Dim sTemp As String
Dim iPos As Long
iPos = InStr(1, Drive, ":")
Drive = IIf(iPos 0, Left(Drive, iPos), Drive & ":")
sTemp = Hex(CreateObject("Scripting.FileSystemObject") _
.Drives.Item(CStr(Drive)).SerialNumber)
DiskVolumeId = Left(sTemp, 4) & "-" & Right(sTemp, 4)
End Function

Regards

Bob

"Michel Pierron" wrote in message
...
Hi Bob,
If you agree, I prefer:

Function DiskVolumeId(Drive As String) As String
DiskVolumeId = Hex(CreateObject("Scripting.FileSystemObject") _
.Drives.Item(CStr(Drive)).SerialNumber)
End Function

MP

"Bob Phillips" a écrit dans le message
de news: ...
A couple of ways (to get different answers :-))


'Using FSO

Function DiskVolumeId(Drive As String) As String
Dim FSO As Object
Set FSO = CreateObject("Scripting.FileSystemObject")
DiskVolumeId = Format(CDbl(FSO.Drives(Drive).SerialNumber))
End Function


snip


--

HTH

RP
(remove nothere from the email address if mailing direct)


"Paul Ramirez" wrote in message
m...
How can I obtain the serial number of a drive that a spreadsheet is
installed on from within the same EXCEL spreadsheet?









Reply
Thread Tools Search this Thread
Search this Thread:

Advanced Search
Display Modes

Posting Rules

Smilies are On
[IMG] code is On
HTML code is Off
Trackbacks are On
Pingbacks are On
Refbacks are On


Similar Threads
Thread Thread Starter Forum Replies Last Post
Look up part of a number within a serial number and cpy back assoc Seantastic Excel Worksheet Functions 9 November 3rd 08 04:10 PM
Obtain row number of active cell Jive Excel Worksheet Functions 4 January 8th 08 01:06 PM
Obtain drive letter assignment of CD/DVD drive? EagleOne Excel Discussion (Misc queries) 1 October 13th 06 01:27 PM
Insert auto serial number in Excel template Van Gel Excel Programming 1 February 18th 05 01:33 PM


All times are GMT +1. The time now is 07:51 PM.

Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
Copyright ©2004-2025 ExcelBanter.
The comments are property of their posters.
 

About Us

"It's about Microsoft Excel"