Extraer caracteres

Por lo que entiendo, creo que buscas un código de este estilo:
Option Explicit
Function extraerParteCodigo(ByVal codigo As String, ByVal separador As String, ByVal numeroOrden As Integer) As String
    Dim n As Integer ' Para buscar el separador
    extraerParteCodigo = ""
    ' Si el número de orden es menor que 1... no nos vale
    If numeroOrden < 1 Then Exit Function
    ' Si no aparece el separador
    If InStr(codigo, separador) = 0 Then
        ' Si el número de orden es el 1 devolvemos el código entero. Sino... no existe
        If numeroOrden = 1 Then extraerParteCodigo = codigo
      Else
        ' Haremos un bucle para buscar el separador e ir quitando la parte que no interese
        Do
            n = InStr(codigo, separador)
            If numeroOrden = 1 Then ' Devolvemos el texto hasta el separador (si lo hay)
                If n = 0 Then n = Len(codigo) + 1 ' Si no hay separador devolvemos todo el texto
                extraerParteCodigo = Left$(codigo, n - 1)
                Exit Do
              Else
                If n > 0 Then ' Quitamos el texto hasta el separador
                    codigo = Right$(codigo, Len(codigo) - n - Len(separador) + 1)
                  Else ' Si no hay separador... era el último y no devolvemos nada
                    Exit Do
                End If
                numeroOrden = numeroOrden - 1 ' Y descontamos 1 del número de orden
            End If
        Loop
    End If
End Function