Option Explicit

 

Private Type cmdArgument

  Name As String

  Value As String

End Type

 

Dim CmdLineArgs() As cmdArgument

Dim lNumberOfArguments As Long

Const csDoubleQuote As String = """"

Const csSingleQuote As String = "'"

Const csSeparator As String = " "

 

Private Function GetCommandLine()

'if you want to use MaxNumberArgs uncomment this line and line

'at the end of this function

'(Optional MaxNumberArgs As Long = 10)

 

'GetCommandLine function parses command line arguments ie their names and values

'CmdLine= [argName1=]argValue1[<space>[argName2=]argValue2... ]

'or if argValue contains space(s)

'it should be in " "(double quotes)or in single quotes(' ')

'CmdLine= [argName1=]"arg Value1"[<space>[argName2=]'arg Value2'... ]

'into collection colCmdLineArgs

 

'Dim colCmdLineArgs As Collection

 

 

Dim sCmdArg As String

Dim lNextSeparatorPosition As Long

'Declare variables.

Dim sChar, sPrevChar As String

Dim sCommandLine As String

Dim lOpenQuotePosition As Long

Dim lCloseQuotePosition As Long

Dim bArgInQuots As Boolean

 

Dim lCommandLineLength As Long

 

Dim CmdLine, CmdLnLen, InArg, i, NumArgs

 

1: sCommandLine = Trim(Command()) & csSeparator

2: lCommandLineLength = Len(sCommandLine)

3: Do Until lCommandLineLength <= Len(csSeparator)

  

4:    lNextSeparatorPosition = InStr(1, sCommandLine, csSeparator)

5:    lOpenQuotePosition = getNextQuotePosition(sCommandLine)

6:    lCloseQuotePosition = getNextQuotePosition(sCommandLine, lOpenQuotePosition + 1)

    

    If (lOpenQuotePosition < lNextSeparatorPosition) And _

       (lCloseQuotePosition > lNextSeparatorPosition) Then

      'there is  separator in quotes

      'then find real argument separator

7:       lNextSeparatorPosition = InStr(lCloseQuotePosition, sCommandLine, csSeparator)

8:        If lNextSeparatorPosition <> lCloseQuotePosition + 1 Then

          'wrong quote position

          'Err.Raise

9:        End If

10:    End If

11:    sCmdArg = Trim(Left(sCommandLine, lNextSeparatorPosition))

12:    sCommandLine = Trim(Right(sCommandLine, lCommandLineLength - lNextSeparatorPosition)) & csSeparator

13:    lCommandLineLength = Len(sCommandLine)

    'increment  NumberOfArguments

14:    lNumberOfArguments = lNumberOfArguments + 1

    

15:    ReDim Preserve CmdLineArgs(1 To lNumberOfArguments)

    'set the Arg Name and Value

16:    CmdLineArgs(lNumberOfArguments) = getCmdArg(sCmdArg)

  

' ----

'uncomment this line if you want to use MaxNumberArgs

    'If lNumberOfArguments = MaxNumberArgs Then Exit Do

17: Loop

    

End Function

 

Private Function getCmdArg(sArgString As String) As cmdArgument

1: On Error GoTo ErrorHandler

Dim sArgName As String

Dim sArgValue As String

Dim lEqualSignPosition As Long

'Dim sArgName

'open qoute

Dim s1Quote As String

'close qoute

Dim s2Quote As String

 

2: sArgString = Trim(sArgString)

3: lEqualSignPosition = InStr(1, sArgString, "=")

4: If lEqualSignPosition = 0 Then

'there is no sArgName

5:    sArgName = ""

6:    sArgValue = sArgString

7: Else

'there is sArgName

8:    sArgName = Left(sArgString, lEqualSignPosition - 1)

9:    sArgValue = Right(sArgString, Len(sArgString) - lEqualSignPosition)

10: End If

 

'check if there is(are) qoutes or double qoutes in sArgValue

11: s1Quote = Left(sArgValue, 1)

12: If s1Quote = csSingleQuote Or s1Quote = csDoubleQuote Then

'if there is leading quot get rid of it

13:  sArgValue = Right(sArgValue, Len(sArgValue) - 1)

14: End If

 

15: s2Quote = Right(sArgValue, 1)

16: If s2Quote = csSingleQuote Or s2Quote = csDoubleQuote Then

'if there is trailing quot get rid of it

17:  sArgValue = Left(sArgValue, Len(sArgValue) - 1)

18: End If

'set return User Define type

19: getCmdArg.Name = sArgName

20: getCmdArg.Value = sArgValue

21: Exit Function

 

ErrorHandler:

 

End Function

 

 

Private Function getNextQuotePosition(ByVal sCommandLine As String, Optional BeginWithPosition As Long = 1) As Long

1: On Error GoTo Error_Handler

Dim lSingleQuotePos As Long

Dim lDoubleQuotePos As Long

 

2: lSingleQuotePos = InStr(BeginWithPosition, sCommandLine, csSingleQuote)

3: lDoubleQuotePos = InStr(BeginWithPosition, sCommandLine, csDoubleQuote)

 

If (lSingleQuotePos < lDoubleQuotePos And _

    lSingleQuotePos > 0 And lDoubleQuotePos > 0) Or lDoubleQuotePos = 0 Then

'

4:  getNextQuotePosition = lSingleQuotePos

5: Else

'if no single quote

'or single quote and double quote exit and lDoubleQuotePos <lSingleQuotePos

 

6:  getNextQuotePosition = lDoubleQuotePos

7: End If

8: Exit Function

 

Error_Handler:

 

End Function

 

Public Function CountArguments() As Long

1: CountArguments = lNumberOfArguments

End Function

 

Public Function GetArgumentName(ByVal CmdArgNumber As Long) As String

1: If CmdArgNumber > 0 And CmdArgNumber <= lNumberOfArguments Then

2:  GetArgumentName = CmdLineArgs(CmdArgNumber).Name

3: End If

End Function

 

Public Function GetArgumentNumber(ByVal CmdArgName As String) As Long

Dim iSubscript As Long

1: For iSubscript = 1 To lNumberOfArguments

2:    If CmdLineArgs(iSubscript).Name = CmdArgName Then

3:      GetArgumentNumber = iSubscript

4:      Exit For

5:    End If

6: Next

End Function

 

Public Function GetArgumentValue(ByVal CmdArgNameOrNumber As Variant) As String

Dim iSubscript As Long

1: If IsNumeric(CmdArgNameOrNumber) Then

2:  If CInt(CmdArgNameOrNumber) >= 1 And CInt(CmdArgNameOrNumber) <= lNumberOfArguments Then

3:  GetArgumentValue = CmdLineArgs(CInt(CmdArgNameOrNumber)).Value

4:  End If

5: Else

6:  For iSubscript = 1 To lNumberOfArguments

7:    If CmdLineArgs(iSubscript).Name = CmdArgNameOrNumber Then

8:      GetArgumentValue = CmdLineArgs(iSubscript).Value

9:      Exit For

10:    End If

11:  Next

12: End If

End Function

 

Private Sub Class_Initialize()

1: Call GetCommandLine

End Sub

a b "x\"x" 555

Option Explicit

Private Declare Function CommandLineToArgvW Lib "shell32.dll" (ByVal nInput As Long, ByRef retcount As Long) As Long

Private Declare Function LocalFree Lib "kernel32" (ByVal hMem As Long) As Long

Private Declare Function SysAllocString Lib "oleaut32" (ByVal nString As Long) As Long

Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (ByVal Destination As Long, ByVal Source As Long, ByVal Length As Long)

 

Public Function CommandLineToArgvVB(ByVal nInput As String) As String()

    Dim ret As Long, retcount As Long, rt() As String, I As Integer, lng As Long

    ret = CommandLineToArgvW(StrPtr(nInput), retcount)

    If retcount > 0 Then

        ReDim rt(retcount - 1)

        For I = 0 To UBound(rt)

            CopyMemory VarPtr(lng), ret + I * 4, 4

            CopyMemory VarPtr(rt(I)), VarPtr(SysAllocString(lng)), 4

        Next

        CommandLineToArgvVB = rt

    End If

    If ret <> 0 Then LocalFree ret

End Function

Private Sub Form_Load()

    Dim ret() As String, I As Long

    ret = CommandLineToArgvVB("a b ""xx yy"" \""abc")

    MsgBox Join(ret, vbCrLf)

    End

End Sub