Calling sub routine or function in VB 6 application via console - vb6

I want to make simple app that has 1 method and 2 parameters in it and
the app can be launched via console/CMD like this:
name_of_app.exe name_of_method param1 param2
example:
I have an app that named myApp.exe that have a method like this
Module Module1
Sub Main()
Console.WriteLine("Hello World!")
Dim x As Integer, y As Integer
Dim total As Integer
x = Console.ReadLine()
y = Console.ReadLine()
total = plus(x, y)
Console.WriteLine("result: " & total)
Console.ReadLine()
End Sub
Private Function plus(ByVal x As Integer, ByVal y As Integer) As Integer
Return x + y
End Function
End Module
So in the console/cmd I just call that function like this
myApp.exe plus 3 2
How can I achieve this?

Private Sub Form_Load()
Dim strCommand As String
Dim s() As String
Dim spliter As String
Dim returnValue As Variant
strCommand = Command
Do While InStr(1, strCommand, " ", vbTextCompare) > 0
strCommand = Replace(strCommand, " ", " ")
Loop
spliter = " "
s = Split(strCommand, spliter)
returnValue = CallByName(Me, s(0), VbMethod, Val(s(1)), Val(s(2)))
MsgBox returnValue
End Sub
Public Function Plus(ByVal Param1 As Variant, ByVal Param2 As Variant)
Plus = Param1 + Param2
End Function

Related

VB6 Converting a fraction to a decimal and a decimal to fraction

There's a few posts on this, but none seem to provide a whole code solution, so I'm posting this up, which is culled (and credited where appropriate) from various bits and pieces of ideas on the Internet. VB6 doesn't have any function to convert from a fraction to a decimal number, which I needed for a project that I was working on which was concerned with meal recipes. I considered writing a DLL in .NET and plugging it into my application, but decided on this approach in the end. I hope this is useful for others. The solution below will do the following:
You supply a decimal number and you will be returned the fraction as a string.
You supply a fraction as a string and you will be returned with the decimal number.
In both cases, whole numbers are accounted for eg. "2 3/4" (two and three quarters) or "2.75".
I'm sure the code is not efficient, so any improvements are welcome.
Copy/Paste this as a new Class module:
Option Explicit
Private ErrorNote As String
'Properties
Public Property Get GetAsFraction(numToConvert As Double) As String
On Error GoTo GetAsFraction_Error
GetAsFraction = FncGetAsFraction(numToConvert)
On Error GoTo 0
Exit Property
GetAsFraction_Error:
ErrorNote = "Number:" & Err.number & " (" & Err.Description & ") in procedure 'GetAsFraction' in 'ClsFractionDecimal'"
MsgBox (ErrorNote)
End Property
Public Property Get GetAsDecimal(fractionString As String) As Double
On Error GoTo GetAsDecimal_Error
GetAsDecimal = FncGetAsDecimal(fractionString)
On Error GoTo 0
Exit Property
GetAsDecimal_Error:
ErrorNote = "Number:" & Err.number & " (" & Err.Description & ") in procedure 'GetAsDecimal' in 'ClsFractionDecimal'"
MsgBox (ErrorNote)
End Property
'Functions - private
Private Function FncGetAsDecimal(fractionToConvert As String) As Double
Dim result As Double
Dim wholeNumber As Integer
Dim splitStr As Variant
Dim numerator As Integer
Dim denominator As Integer
Dim fractionString As String
Dim dividedByPos As Integer
On Error GoTo FncGetAsDecimal_Error
splitStr = Split(fractionToConvert, " ")
If UBound(splitStr) = 1 Then
wholeNumber = splitStr(0)
fractionString = splitStr(1)
Else
fractionString = splitStr(0)
End If
dividedByPos = InStr(1, fractionString, "/")
numerator = Left(fractionString, dividedByPos - 1)
denominator = Mid(fractionString, dividedByPos + 1)
result = Val(numerator) / Val(denominator) + wholeNumber
FncGetAsDecimal = result
On Error GoTo 0
Exit Function
FncGetAsDecimal_Error:
ErrorNote = "Number:" & Err.number & " (" & Err.Description & ") in procedure 'FncGetAsDecimal' in 'ClsFractionDecimal'"
MsgBox (ErrorNote)
End Function
Private Function FncGetAsFraction(numToConvert As Double) As String
Dim result As String
Dim numeratorCount As Integer
Dim denominator As Single
Dim multiplierStr As String
Dim i As Integer
Dim fractionNum As Single
Dim lowestCommonDenominator As Long
Dim wholeNumber As Integer
Dim decimalPos As Integer
On Error GoTo FncGetAsFraction_Error
If numToConvert > 0 Then
decimalPos = InStr(1, CStr(numToConvert), ".")
If decimalPos > 1 Then
wholeNumber = CStr(Mid(numToConvert, 1, decimalPos - 1))
numToConvert = CStr(Mid(numToConvert, decimalPos))
End If
numeratorCount = FncCountDecimalPlaces(numToConvert)
multiplierStr = "1"
For i = 1 To numeratorCount
multiplierStr = multiplierStr & "0"
Next i
fractionNum = numToConvert * Val(multiplierStr)
denominator = 1 * Val(multiplierStr)
result = FncCrunchFraction(fractionNum, denominator)
If result = "" Then result = fractionNum & "/" & denominator
If wholeNumber <> 0 Then result = wholeNumber & " " & result
Else
result = "ERROR"
End If
FncGetAsFraction = result
On Error GoTo 0
Exit Function
FncGetAsFraction_Error:
ErrorNote = "Number:" & Err.number & " (" & Err.Description & ") in procedure 'FncGetAsFraction' in 'ClsFractionDecimal'"
MsgBox (ErrorNote)
End Function
Private Function FncCountDecimalPlaces(num As Double) As Integer
Dim result As Integer
Dim numberStr As String
Dim i As Integer
Dim decimalPointPos As Integer
On Error GoTo FncCountDecimalPlaces_Error
numberStr = CStr(num)
If Len(numberStr) > 0 Then
i = 1
Do While i <= Len(numberStr) And decimalPointPos = 0
If Mid(numberStr, i, 1) = "." Then decimalPointPos = i
i = i + 1
Loop
End If
If i > 1 Then
result = (Len(numberStr) - i + 1)
End If
FncCountDecimalPlaces = result
On Error GoTo 0
Exit Function
FncCountDecimalPlaces_Error:
ErrorNote = "Number:" & Err.number & " (" & Err.Description & ") in procedure 'FncCountDecimalPlaces' in 'ClsFractionDecimal'"
MsgBox (ErrorNote)
End Function
'Credit to:
'http://www.tek-tips.com/viewthread.cfm?qid=206890
'dsi (Programmer) - 7 Feb 02 10:38
Private Function FncCrunchFraction(num1 As Single, num2 As Single) As String
Dim num As Single
Dim dem As Single
Dim cnt1 As Integer
Dim cnt2 As Integer
Dim numFactors() As Single
Dim demFactors() As Single
Dim common As Single
Dim i As Integer
Dim j As Integer
On Error GoTo FncCrunchFraction_Error
num = num1
dem = num2
For i = 2 To Int(num / 2) Step 1
If (num Mod i = 0) Then
cnt1 = cnt1 + 1
ReDim Preserve numFactors(1 To cnt1)
numFactors(cnt1) = i
End If
Next i
cnt1 = cnt1 + 1
ReDim Preserve numFactors(1 To cnt1)
numFactors(cnt1) = num
For i = 2 To Int(dem / 2) Step 1
If (dem Mod i = 0) Then
cnt2 = cnt2 + 1
ReDim Preserve demFactors(1 To cnt2)
demFactors(cnt2) = i
End If
Next i
cnt2 = cnt2 + 1
ReDim Preserve demFactors(1 To cnt2)
demFactors(cnt2) = dem
For i = cnt1 To 1 Step -1
For j = cnt2 To 1 Step -1
If (numFactors(i) = demFactors(j)) Then
common = numFactors(i)
FncCrunchFraction = num / common & "/" & dem / common
Exit Function
End If
Next j
Next i
FncCrunchFraction = ""
On Error GoTo 0
Exit Function
FncCrunchFraction_Error:
ErrorNote = "Line:" & Erl & " Number:" & Err.number & " (" & Err.Description & ") in procedure 'FncCrunchFraction' in 'ClsFractionDecimal'"
MsgBox (ErrorNote)
End Function
Then call it with these code examples:
Public Function DecimalToFraction(number As Double) As String
Dim myFractionDecimal As New ClsFractionDecimal
DecimalToFraction = myFractionDecimal.GetAsFraction(number)
Set myFractionDecimal = Nothing
End Function
Public Function FractionToDecimal(fractionString As String) As Double
Dim myFractionDecimal As New ClsFractionDecimal
FractionToDecimal = myFractionDecimal.GetAsDecimal(fractionString)
Set myFractionDecimal = Nothing
End Function

Risk Game not displaying score

I'm doing an assignment for my class called "Risk!", the basis of it is that you start with 1000 points, and input a number to risk. You roll 2 dice. If it's even, you lose and the input is removed from score. If it's odd, you win and input is added to score. For some reason, the score isn't displayed correctly.
Private Sub cmdQuit_Click()
Unload Me
End Sub
Private Sub cmdRollDice_Click()
intNumOutput1 = Int(Rnd * 6) + 1
intNumOutput2 = Int(Rnd * 6) + 1
lblNumOutput1.Caption = intNumOutput1
lblNumOutput2.Caption = intNumOutput2
intBothOutputs = intNumOutput1 + intNumOutput2
If intBothOutputs Mod 2 > 0 Then
intScore = intScore + intNumInput
MsgBox "odd, win"
Else
intScore = intScore - intNumInput
MsgBox "even, lose"
End If
lblTotal.Caption = "Your new point total is " & intScore
End Sub
Private Sub Form_Load()
Randomize
Dim intScore As Integer
Dim intNumOutput1 As Integer
Dim intNumOutput2 As Integer
Dim intBothOutputs As Integer
Dim intNumInput As Integer
txtNumInput.Text = intNumInput
intScore = 1000
txtNumInput.Text = ""
lblNumOutput1.Caption = ""
lblNumOutput2.Caption = ""
End Sub
When you want to use variables in more than one method (e.g. sub, function), you declare the variables outside of any method.
Now, since you declared your variables inside Form_Load, you can't use them in cmdRollDice_Click or in any other method. So, what happens when you use them in a method other than the one they were declared in? Well, if you have Option Explicit statement on top of your code, you'll get a run-time error. If you don't (which is your current case), the variables will get initialized -with zero value- each time the method is called (note: they're now not the same variables that were declared in Form_Load).
Hence, you need to declare your variables on top of your file (before all functions/subs) like the following:
Dim intScore As Integer
Dim intNumOutput1 As Integer
Dim intNumOutput2 As Integer
Dim intBothOutputs As Integer
Dim intNumInput As Integer
' The rest of your code
Private Sub Form_Load()
End Sub
Private Sub cmdRollDice_Click()
End Sub
'
'
So, as a rule: you declare variables inside a method ONLY if you don't need to use them outside that method.
For more information about this, read Understanding the Scope of Variables
Hope that helps :)
For string concatenation its best practice to convert data types to string using cstr. e.g. CStr(intScore)
Add the event handler for txtNumInput. You have not assigned the value to intNumInput whenever button is clicked.
Try below.
Option Explicit
Private intScore As Integer
Private intNumOutput1 As Integer
Private intNumOutput2 As Integer
Private intBothOutputs As Integer
Private intNumInput As Integer
Private Sub cmdRollDice_Click()
Dim intNumOutput1 As Integer
Dim intNumOutput2 As Integer
Dim intBothOutputs As Integer
intNumOutput1 = Int(Rnd * 6) + 1
intNumOutput2 = Int(Rnd * 6) + 1
lblNumOutput1.Caption = intNumOutput1
lblNumOutput2.Caption = intNumOutput2
intBothOutputs = intNumOutput1 + intNumOutput2
If intBothOutputs Mod 2 > 0 Then
intScore = intScore + intNumInput
MsgBox "odd, win"
Else
intScore = intScore - intNumInput
MsgBox "even, lose"
End If
lblTotal.Caption = "Your new point total is " & CStr(intScore)
End Sub
Private Sub txtNumInput_Change()
If IsNumeric(txtNumInput.Text) Then
intNumInput = CInt(txtNumInput.Text)
End If
End Sub

vb6 Compare times in list with current time

I'm making form where i need to enter the time's for each period like.
Start time - End time
Start time - End time
Start time - End time
Those record's could be saved in listbox as in my example. On another form i have 3 labels
CurrentTime, TimePassed, TimeLeft, and a Timer which ticks in interval 1second. So the time in timepassed ticking up, time left ticking down, and current time show correct time while application is opened.
In final it looks like this
Private Sub cmdAdd_Click()
Call addp
End Sub
Function addp(Optional ByVal t As String)
Dim s As String, e As String
If t = "" Then s = Trim(InputBox("Start time (hh:mm AM/PM):")) Else: s = Trim(Split(t, "-")(0))
If s = "" Or InStr(1, s, " AM") = 0 And InStr(1, s, " PM") = 0 Then Exit Function
If chk(s) = False Then Exit Function
If t = "" Then e = Trim(InputBox(s & "-?" & vbCrLf & "End time:")) Else: e = Trim(Split(t, "-")(1))
If e = "" Or InStr(1, e, " AM") = 0 And InStr(1, e, " PM") = 0 Then Exit Function
If e = s Then Exit Function
If chk(e) = False Then Exit Function
If Format$(Split(s, "-")(0), "hh:mm AM/PM") > Format$(Split(e, "-")(0), "hh:mm AM/PM") Then Exit Function
If lstPeriods.List(0) <> "" Then
If Format$(Split(lstPeriods.List(lstPeriods.ListCount - 1), "-")(1), "hh:mm AM/PM") > Format$(Split(s, "-")(0), "hh:mm AM/PM") Then Exit Function
End If
lstPeriods.AddItem lstPeriods.ListCount + 1 & ". " & s & "-" & e
If frmMain.lblPeriod.Caption = "" Then Call snd(s & "-" & e, lstPeriods.ListCount)
End Function
For check
Function chk(ByVal st As String) As Boolean
st = Replace$(Replace$(st, " AM", ""), " PM", "")
If UBound(Split(st, ":")) <> 1 Then Exit Function
For i = 0 To 1
If IsNumeric(Split(st, ":")(i)) = False Then Exit Function
If Len(Split(st, ":")(i)) <> 2 Then Exit Function
If Split(st, ":")(i) < 0 Then Exit Function
Next
If Split(st, ":")(0) > 12 Then Exit Function
If Split(st, ":")(1) > 59 Then Exit Function
chk = True
End Function
The solution i gave is the only solution which beginner as i I had. And i know it's confusing and very slow. There is no way this can be finished by using trim/split/format because it require for a lot of modification.
Searching for easier solution.
Sp i need to compare the current time on computer with the time person enetered in textbox/listbox how can i do that .
To Run this code you need to add 5 Controls to the Form1
lblSystemTime = Label Control
lblTimeLeft = Label Control
lblTimePassed = Label Control
lblPeriod = Label Control
tmrSystemTime = Timer Control
Dim Periods()
Private Sub Form_Load()
Periods = Array( _
"06:00 PM-07:00PM", _
"07:01 PM-08:00PM", _
"09:00 PM-10:00PM", _
"1AM-2AM" _
)
End Sub
Private Sub tmrSystemTime_Timer()
lblSystemTime.Caption = FormatDateTime(Now, vbLongTime)
Dim OnPeriod As Integer
OnPeriod = GetPeriod()
If OnPeriod < 0 Then
lblTimeLeft.Caption = vbNullString
lblTimePassed.Caption = vbNullString
lblPeriod.Caption = "Unknown Period"
Else
lblPeriod = CStr(OnPeriod + 1) & ". period"
lblTimeLeft.Caption = "Time Left: " & Format( _
DateAdd("s", _
DateDiff("s", _
CDate(lblSystemTime.Caption), _
CDate(Split(Periods(OnPeriod), "-")(1))), _
CDate("0") _
), _
"nn:ss" _
)
lblTimePassed.Caption = "Time Passed: " & Format( _
DateAdd("s", _
DateDiff("s", _
CDate(Split(Periods(OnPeriod), "-")(1)), _
CDate(lblSystemTime.Caption)), _
CDate("0") _
), _
"nn:ss" _
)
End If
End Sub
Private Function GetPeriod() As Integer
Dim ICount As Integer
For Each Pr In Periods
If CDate(Split(Pr, "-")(0)) <= CDate(lblSystemTime.Caption) And _
CDate(Split(Pr, "-")(1)) >= CDate(lblSystemTime.Caption) Then
GetPeriod = ICount
Exit Function
End If
ICount = ICount + 1
Next
GetPeriod = -1
End Function
Here is something which may help:
Private Sub TimeCheck(byval int_TimeNow as Integer)
dim intTimeThen as string 'set a variable to compare for the THEN time
dim intTimeNow as string 'set a variable to compare for the NOW time
dim intDiff as string ' set a variable for the difference in time
intTimeNow = int_TimeNow 'just to ensure we don't mess with any data
intTimeThen = val(txtTimeThen.text) 'get the numeric value of the time, the system will
'convert it from a string to the value here.
intDiff = intTimeThen - intTimeNow 'Do the math
lstTimeEvents.additem timevalue(intDiff) 'write it to a listbox
End Sub
I realize this is not the coding convention you are using, but it should demonstrate what you are looking for to some degree.

display a series of images in Excel 2010 using VBA

As part of a larger project I need to display a series of images within the one macro. When I run this it displays the final image after the last msgbox, with the others layered underneath:
Sub Macro4()
Dim x As Integer
Dim Pic As Object
Dim picname As String
For x = 1 To 7
picname = ThisWorkbook.Path & "/" & "pic" & x & ".png"
ActiveSheet.Pictures.Insert(picname).Select
MsgBox (x)
Next x
End Sub
The Msgbox command is there to slow the process down so that I can see, or in this case not see, the pictures change.
The images are called pic1.png, pic2.png etc
How do I get the separate images to show during the macro?
RE-EDIT:
So here is the picture function and the larger function which plays a randomised piece of Musique Concret.
Private Declare Function PlaySound Lib "winmm.dll" _
Alias "PlaySoundA" (ByVal lpszName As String, _
ByVal hModule As Long, ByVal dwFlags As Long) As Long
showpic gives an image relative to the pitch of the sound being played.
Function showpic(value)
Dim v As Integer
v = value
picname = ThisWorkbook.Path & "/" & "pic" & v & ".png"
ActiveSheet.Shapes.AddPicture (picname), True, True, a1, a1, 170, 170
DoEvents
End Function
play runs a series of specific sound files generated by a randomised process choosing instrument and pitch and creating the requisite filename. The "piece" runs for 'notes' seconds and is triggered by a separate macro that changes the value in a given 'cell' to match the 'condition'.
Function play(Cell, condition, notes)
Dim WAVFile As String
Dim x As Integer
Dim y As Integer
Dim z As Integer
Dim c As String
Dim d As String
Dim currentcell As String
Dim pitchcell As String
Const SND_SYNC = &H0
Const SND_ASYNC = &H1
Const SND_FILENAME = &H20000
On Error GoTo ErrHandler
For x = 1 To notes
If Evaluate(Cell.value & condition) Then
y = x + 65
z = x + 39
c = Chr(y)
d = Chr(z)
If y > 90 Then c = "A" & d
currentcell = c & 6
pitchcell = c & 3
showpic (Sheets("Sheet1").Range(pitchcell).value)
WAVFile = ThisWorkbook.Path & "/" & Sheets("Sheet1").Range(currentcell).Text & ".wav"
Call PlaySound(WAVFile, 0&, SND_SYNC)
End If
Next x
ErrHandler:
play = False
Exit Function
End Function
I have three problems:
It doesn't show the first image file
It performs a 'calculate' or F9 at the beginning so re-randomises the piece and doesn't play the displayed sequence; I presume this is caused by the first DoEvents.
It now plays twice! However, the second time through it does show all the image files.
Edit:
Since my initial answer didn't work for you, how about achieving your results a completely different way. This method using Application.OnTime to re-run your sub and insert the next picture.
Sub NextPicture()
Static x As Integer
Dim pic As Object
Dim picname As String
'Reset x to 0 because I assumed you want to rotate through the pictures.
'If you want it to stop replace with If x = 7 then exit sub
If x = 7 Then x = 0
x = x + 1
picname = ThisWorkbook.Path & "/" & "pic" & x & ".png"
ActiveSheet.Pictures.Insert(picname).Select
'Using 00:00:05 = 5 seconds, change the amount to speed up or slow down the picture changes
Application.OnTime Now + TimeValue("00:00:05"), "NextPicture"
End Sub
Original Answer
I could not get your code to work, but I could if I used Shapes.AddPicture, which is actually more robust because you get/have to specify the location and size.
Syntax:
expression.AddPicture(Filename, LinkToFile, SaveWithDocument, Left, Top, Width, Height)
Example:
ActiveSheet.Shapes.AddPicture(picname, True, True, 100, 100, 70, 70)

Convert from \Device\HarddiskVolume1 to C: in vb6

Is there any way to convert from \Device\HarddiskVolume1\programfile\explorer.exe to C:\programfile\explorer.exe in visual basic 6?
thanks
Try this
Option Explicit
Private Declare Function QueryDosDevice Lib "kernel32" Alias "QueryDosDeviceA" (ByVal lpDeviceName As String, ByVal lpTargetPath As String, ByVal ucchMax As Long) As Long
Private Sub Command1_Click()
Debug.Print pvReplaceDevice("\Device\HarddiskVolume1\aaa.txt")
End Sub
Private Function pvReplaceDevice(sPath As String) As String
Dim sDrive As String
Dim sDevice As String
Dim lIdx As Long
For lIdx = 0 To 25
sDrive = Chr$(65 + lIdx) & ":"
sDevice = Space(1000)
If QueryDosDevice(sDrive, sDevice, Len(sDevice)) <> 0 Then
sDevice = Left$(sDevice, InStr(sDevice, Chr$(0)) - 1)
' Debug.Print sDrive; "="; sDevice
If LCase$(Left$(sPath, Len(sDevice))) = LCase$(sDevice) Then
pvReplaceDevice = sDrive & Mid$(sPath, Len(sDevice) + 1)
Exit Function
End If
End If
Next
pvReplaceDevice = sPath
End Function
If you want an efficient use of API functions, create a class - "DiskDevice"
Option Explicit
Private Declare Function GetLogicalDriveStrings Lib "Kernel32" Alias "GetLogicalDriveStringsW" ( _
ByVal nBufferLength As Long, _
ByVal lpBuffer As Long _
) As Long
Private Declare Function QueryDosDevice Lib "Kernel32.dll" Alias "QueryDosDeviceW" ( _
ByVal lpDeviceName As Long, _
ByVal lpTargetPath As Long, _
ByVal ucchMax As Long _
) As Long
Private m_colDrivesKeyedByDevice As VBA.Collection
Private Sub Class_Initialize()
Dim sDriveStrings As String
Dim vasDriveStrings As Variant
Dim nIndex As Long
Dim sDrive As String
' Allocate max size buffer [A-Z]:\\\0 and retrieve all drives on the system.
sDriveStrings = Space$(105)
GetLogicalDriveStrings 1000, StrPtr(sDriveStrings)
' Split over the null chars between each substring.
vasDriveStrings = Split(sDriveStrings, vbNullChar)
Set m_colDrivesKeyedByDevice = New VBA.Collection
' Iterate through each drive string (escaping later if any item is null string).
For nIndex = 0 To UBound(vasDriveStrings)
sDrive = Left$(vasDriveStrings(nIndex), 2) ' Ignore the backslash.
If Len(sDrive) = 0 Then
Exit For
End If
' Create mapping from Drive => Device
m_colDrivesKeyedByDevice.Add sDrive, GetDeviceForDrive(sDrive)
Next nIndex
End Sub
' Retrieve the device string \device\XXXXXX for the drive X:
Private Function GetDeviceForDrive(ByRef the_sDrive As String)
Const knBufferLen As Long = 1000
Dim sBuffer As String
Dim nRet As Long
sBuffer = Space$(knBufferLen)
nRet = QueryDosDevice(StrPtr(the_sDrive), StrPtr(sBuffer), knBufferLen)
GetDeviceForDrive = Left$(sBuffer, nRet - 2) ' Ignore 2 terminating null chars.
End Function
Public Function GetFilePathFromDevicePath(ByRef the_sDevicePath As String) As String
Dim nPosSecondBackslash As Long
Dim nPosThirdBackslash As Long
Dim sDevice As String
Dim sDisk As String
' Path is always \Device\<device>\path1\path2\etc. Just get everything before the third backslash.
nPosSecondBackslash = InStr(2, the_sDevicePath, "\")
nPosThirdBackslash = InStr(nPosSecondBackslash + 1, the_sDevicePath, "\")
sDevice = Left(the_sDevicePath, nPosThirdBackslash - 1)
sDisk = m_colDrivesKeyedByDevice.Item(sDevice) ' Lookup
' Reassemble, this time with disk.
GetFilePathFromDevicePath = sDisk & Mid$(the_sDevicePath, nPosThirdBackslash)
End Function
Now, you use code like:
Set m_oDiskDevice = New DiskDevice
...
sMyPath = m_oDiskDevice.GetFilePathFromDevicePath("\Device\HarddiskVolume1\programfile\explorer.exe")
That way you don't have to call the API functions multiple times - you just do a collection lookup.

Resources