RÉCUPÉRATION DES ARGUMENTS D'UN ÉXÉCUTABLE LANCÉ EN LIGNE DE COMMANDE

Attribute VB_Name = "MainModule"
Option Explicit

' Le projet doit démarrer sur SubMain (Options du projet)

Private Sub Main()
    Dim SaveTitle As String
    
    ' Vérifie qu'une autre instance du programme n'est pas déjà en cours...
    If App.PrevInstance Then
        SaveTitle = App.Title
        AppActivate SaveTitle
        End
    End If
    
    ' Récupère les paramètres de la ligne de commande
    Dim strArgArray() As String
    Dim intNbArgs As Integer

    If GetCommandLine(strArgArray, intNbArgs) Then
        ' Ici on dispose d'un tableau strArgArray contenant intNbArgs arguments
        ' On peut afficher la feuille par Load Form1 puis Form1.Show
    End If
End Sub

Private Function GetCommandLine( _
    ByRef ArgArray() As String, _
    ByRef NbArgs As Integer, _
    Optional MaxArgs) As Boolean
    
    Dim Char As String * 1
    Dim CommandLine As String
    Dim CommandLineLength, CharNumber As Integer
    Dim InArg, InLongArg As Boolean
    
    ' Contrôle si un nombre max d'arguments est précisé, sinon max=3
    If IsMissing(MaxArgs) Then MaxArgs = 3
    ' Récupère la ligne de commande
    CommandLine = Command()
    CommandLineLength = Len(CommandLine)
    ' Trouve les arguments un par un
    NbArgs = 0
    For CharNumber = 1 To CommandLineLength
        Char = Mid(CommandLine, CharNumber, 1)
        ' Vérifie s'il y a des guillemets dans les arguments (pour les noms de fichier long, par exemple
        If Char = """" Then InLongArg = True
        If InLongArg Then
            If Char = """" Then
                If Not InArg Then
                    If NbArgs = MaxArgs Then Exit For
                    NbArgs = NbArgs + 1
                    ReDim Preserve ArgArray(1 To NbArgs) As String
                    InArg = True
                Else
                    InArg = False
                    InLongArg = False
                End If
            Else
                If InArg Then
                    ArgArray(NbArgs) = ArgArray(NbArgs) & Char
                End If
            End If
        Else
            If Char <> " " And Char <> vbTab Then
                If Not InArg Then
                    If NbArgs = MaxArgs Then Exit For
                    NbArgs = NbArgs + 1
                    ReDim Preserve ArgArray(1 To NbArgs) As String
                    InArg = True
                End If
                ArgArray(NbArgs) = ArgArray(NbArgs) & Char
            Else
                InArg = False
            End If
        End If
    Next CharNumber
    GetCommandLine = (NbArgs > 0)
End Function

Télécharger le zip