XL 2021 Fichier Excel VBA mis en quarantaine par l'antivirus

  • Initiateur de la discussion Initiateur de la discussion Anr1
  • Date de début Date de début
  • Mots-clés Mots-clés
    vba

Boostez vos compétences Excel avec notre communauté !

Rejoignez Excel Downloads, le rendez-vous des passionnés où l'entraide fait la force. Apprenez, échangez, progressez – et tout ça gratuitement ! 👉 Inscrivez-vous maintenant !

Anr1

XLDnaute Occasionnel
Bonjour à toutes et à tous,


J'utilisais jusqu’à récemment le fichier en pièce jointe (récupéré grâce à un contact sur ce forum @p56 ), sans aucun souci. Il me permettait d’obtenir automatiquement le code postal, le secteur d’activité, etc., à partir d’un numéro SIREN.

Mais depuis quelque temps, dès que je clique sur le bouton pour lancer la macro, le fichier disparaît de mon ordinateur et mon antivirus le met en quarantaine.


Est-ce que quelqu’un aurait une solution ou saurait comment éviter ce blocage ? J’ai vraiment besoin de ce fichier pour mon travail…

Le mot de passe : 1234


Merci beaucoup pour votre aide 🙏
 

Pièces jointes

Bonjour,
Pas d'erreur chez moi.
Normal, puisqu'il n'y a aucunes valeurs dans le tableau, pas de deroulement du code
Pour savoir a qu'elle ligne votre anti virus vous ejecte:
Mettez un point d'arret sur With de ma procedure Lire_sirene
Lancer le code par le bouton
L'execution du code s'arrete au point d'arret
Appuyez sur la touche F8 pour faire derouler le code ligne par ligne
Normalement vous trouverez la ligne qui derange votre anti-virus
 
Salut,
j'ai testé le classeur avec virustotal.com (en ligne) qui teste avec 63 antivirus différents.
Une seule détection :
VirIT W97M/Downloader.AR Acronis (Static ML)
ce qui me parait logique car dans le code il doit y avoir téléchargement de données par internet.
Nullosse.
 
Bonjour,
Pas d'erreur chez moi.
Normal, puisqu'il n'y a aucunes valeurs dans le tableau, pas de deroulement du code
Pour savoir a qu'elle ligne votre anti virus vous ejecte:
Mettez un point d'arret sur With de ma procedure Lire_sirene
Lancer le code par le bouton
L'execution du code s'arrete au point d'arret
Appuyez sur la touche F8 pour faire derouler le code ligne par ligne
Normalement vous trouverez la ligne qui derange votre anti-virus
Bonjour @Oneida et merci pour votre aide,


Malheureusement, je ne peux pas faire le test avec le point d’arrêt car dès que je clique sur le bouton pour lancer la macro, le fichier disparaît immédiatement de mon ordinateur 😓
Mon antivirus le met directement en quarantaine avant même que j’aie le temps de voir quoi que ce soit.


C’est vraiment bloquant, car j’utilisais ce fichier sans problème jusqu’à récemment. Si vous avez une idée de comment contourner ça ou sécuriser le fichier, je suis preneur !


Merci encore 🙏
 
Salut,
j'ai testé le classeur avec virustotal.com (en ligne) qui teste avec 63 antivirus différents.
Une seule détection :
VirIT W97M/Downloader.AR Acronis (Static ML)
ce qui me parait logique car dans le code il doit y avoir téléchargement de données par internet.
Nullosse.
Salut @nullosse ,

Merci beaucoup pour le test avec VirusTotal, c’est super utile !

Je comprends mieux maintenant pourquoi peut être mon antivirus le bloque dès que j’active la macro.

Est ce que vous avez des conseils pour contourner ça (ou sécuriser le code pour éviter ce type de détection), je suis vraiment preneur.

Encore merci pour votre aide 🙏
 
D'après le code à mon avis c'est plutôt la partie Décodage JSON qui injecte du javascript qui pose problème. Il faut essayer de mettre cette partie en commentaire pour voir si c'est cela qui pose problème sachant qu'il y a d'autres méthodes que le javascript pour décoder le JSON
 
Hello,

dans les paramètres de l'antivirus il devrait y avoir la possibilité d'exclure un fichier ou un dossier...
Au pire pour faire ce que propose Oneida, désactivez temporairement l'antivirus et idem dans Sécurité Windows qui prend le relai quand aucun AV n'est détecté
 
Salut,
Pour éviter d'utiliser du javascript voici un code qui utilise un parseur JSON en VBA
code du parseur à mettre dans un module ModuleJSON :
VB:
'-------------------------------------------------------------------
' VBA JSON Parser
'-------------------------------------------------------------------
Option Explicit
Private p&, token, dic
Function ParseJSON(json$, Optional key$ = "obj") As Object
    p = 1
    token = Tokenize(json)
    Set dic = CreateObject("Scripting.Dictionary")
    If token(p) = "{" Then ParseObj key Else ParseArr key
    Set ParseJSON = dic
End Function
Function ParseObj(key$)
    Do: p = p + 1
        Select Case token(p)
            Case "]"
            Case "[":  ParseArr key
            Case "{"
                       If token(p + 1) = "}" Then
                           p = p + 1
                           dic.Add key, "null"
                       Else
                           ParseObj key
                       End If
               
            Case "}":  key = ReducePath(key): Exit Do
            Case ":":  key = key & "." & token(p - 1)
            Case ",":  key = ReducePath(key)
            Case Else: If token(p + 1) <> ":" Then dic.Add key, token(p)
        End Select
    Loop
End Function
Function ParseArr(key$)
    Dim e&
    Do: p = p + 1
        Select Case token(p)
            Case "}"
            Case "{":  ParseObj key & ArrayID(e)
            Case "[":  ParseArr key
            Case "]":  Exit Do
            Case ":":  key = key & ArrayID(e)
            Case ",":  e = e + 1
            Case Else: dic.Add key & ArrayID(e), token(p)
        End Select
    Loop
End Function
'-------------------------------------------------------------------
' Support Functions
'-------------------------------------------------------------------
Function Tokenize(s$)
    Const Pattern = """(([^""\\]|\\.)*)""|[+\-]?(?:0|[1-9]\d*)(?:\.\d*)?(?:[eE][+\-]?\d+)?|\w+|[^\s""']+?"
    Tokenize = RExtract(s, Pattern, True)
End Function
Function RExtract(s$, Pattern, Optional bGroup1Bias As Boolean, Optional bGlobal As Boolean = True)
  Dim c&, m, n, v
  With CreateObject("vbscript.regexp")
    .Global = bGlobal
    .MultiLine = False
    .IgnoreCase = True
    .Pattern = Pattern
    If .TEST(s) Then
      Set m = .Execute(s)
      ReDim v(1 To m.Count)
      For Each n In m
        c = c + 1
        v(c) = n.Value
        If bGroup1Bias Then If Len(n.submatches(0)) Or n.Value = """""" Then v(c) = n.submatches(0)
      Next
    End If
  End With
  RExtract = v
End Function
Function ArrayID$(e)
    ArrayID = "(" & e & ")"
End Function
Function ReducePath$(key$)
    If InStr(key, ".") Then ReducePath = Left(key, InStrRev(key, ".") - 1) Else ReducePath = key
End Function
Function ListPaths(dic)
    Dim s$, v
    For Each v In dic
        s = s & v & " --> " & dic(v) & vbLf
    Next
    Debug.Print s
End Function
Function GetFilteredValues(dic, match)
    Dim c&, i&, v, w
    v = dic.keys
    ReDim w(1 To dic.Count)
    For i = 0 To UBound(v)
        If v(i) Like match Then
            c = c + 1
            w(c) = dic(v(i))
        End If
    Next
    ReDim Preserve w(1 To c)
    GetFilteredValues = w
End Function
Function GetFilteredTable(dic, cols)
    Dim c&, i&, j&, v, w, z
    v = dic.keys
    z = GetFilteredValues(dic, cols(0))
    ReDim w(1 To UBound(z), 1 To UBound(cols) + 1)
    For j = 1 To UBound(cols) + 1
         z = GetFilteredValues(dic, cols(j - 1))
         For i = 1 To UBound(z)
            w(i, j) = z(i)
         Next
    Next
    GetFilteredTable = w
End Function
Function OpenTextFile$(f)
    With CreateObject("ADODB.Stream")
        .Charset = "utf-8"
        .Open
        .LoadFromFile f
        OpenTextFile = .ReadText
    End With
End Function
voici un exemple d'utilisation pour extraire des données :
Code:
Sub Lire_sirene()
Dim Jsn As String, val As String, i As Integer
Dim DictJSON As Object
    On Error GoTo errhdlr
    With Sheets("Feuil1")
        For i = 2 To .Cells(Rows.Count, "A").End(xlUp).Row
            val = Format(.Cells(i, "A").Value, "000000000")
            With CreateObject("MSXML2.XMLHTTP")
              .Open "GET", BASE_SIRENE & val & "&limit=20", False
              .send
              Jsn = .responseText
            End With
            Set DictJSON = ParseJSON(Jsn)
            If Not DictJSON Is Nothing Then
                    .Cells(i, "B").Value = "'" & DictJSON("obj.results(0).codepostaletablissement")
                    .Cells(i, "C").Value = "'" & DictJSON("obj.results(0).libellecommuneetablissement")
                    .Cells(i, "D").Value = "'" & DictJSON("obj.results(0).siretsiegeunitelegale")
            End If
        Next i
    End With
    Exit Sub
errhdlr:
    MsgBox "Erreur : adresse URL à vérifier."
End Sub
La constante BASE_SIRENE du classeur fourni ici n'est pas bonne, utilisé celle du dernier classeur de p56.

Nullosse.
 
Bonjour à tous,
Votre antivirus scanne le fichier avant le lancement ce qui est normal non ? Donc comme annoncé plus haut soit vous déplacer le fichier dans un emplacement sûr, soit vous désactiver le scan. Mais la meilleure solution à mon sens c'est de faire parvenir le code du classeur à l'entreprise qui gère votre Ant-virus pour qu'ils vérifient le fichier et mettent à jour les bases. Car à mon avis c'est un faux-positif.
 
Salut,
Pour éviter d'utiliser du javascript voici un code qui utilise un parseur JSON en VBA
code du parseur à mettre dans un module ModuleJSON :
VB:
'-------------------------------------------------------------------
' VBA JSON Parser
'-------------------------------------------------------------------
Option Explicit
Private p&, token, dic
Function ParseJSON(json$, Optional key$ = "obj") As Object
    p = 1
    token = Tokenize(json)
    Set dic = CreateObject("Scripting.Dictionary")
    If token(p) = "{" Then ParseObj key Else ParseArr key
    Set ParseJSON = dic
End Function
Function ParseObj(key$)
    Do: p = p + 1
        Select Case token(p)
            Case "]"
            Case "[":  ParseArr key
            Case "{"
                       If token(p + 1) = "}" Then
                           p = p + 1
                           dic.Add key, "null"
                       Else
                           ParseObj key
                       End If
              
            Case "}":  key = ReducePath(key): Exit Do
            Case ":":  key = key & "." & token(p - 1)
            Case ",":  key = ReducePath(key)
            Case Else: If token(p + 1) <> ":" Then dic.Add key, token(p)
        End Select
    Loop
End Function
Function ParseArr(key$)
    Dim e&
    Do: p = p + 1
        Select Case token(p)
            Case "}"
            Case "{":  ParseObj key & ArrayID(e)
            Case "[":  ParseArr key
            Case "]":  Exit Do
            Case ":":  key = key & ArrayID(e)
            Case ",":  e = e + 1
            Case Else: dic.Add key & ArrayID(e), token(p)
        End Select
    Loop
End Function
'-------------------------------------------------------------------
' Support Functions
'-------------------------------------------------------------------
Function Tokenize(s$)
    Const Pattern = """(([^""\\]|\\.)*)""|[+\-]?(?:0|[1-9]\d*)(?:\.\d*)?(?:[eE][+\-]?\d+)?|\w+|[^\s""']+?"
    Tokenize = RExtract(s, Pattern, True)
End Function
Function RExtract(s$, Pattern, Optional bGroup1Bias As Boolean, Optional bGlobal As Boolean = True)
  Dim c&, m, n, v
  With CreateObject("vbscript.regexp")
    .Global = bGlobal
    .MultiLine = False
    .IgnoreCase = True
    .Pattern = Pattern
    If .TEST(s) Then
      Set m = .Execute(s)
      ReDim v(1 To m.Count)
      For Each n In m
        c = c + 1
        v(c) = n.Value
        If bGroup1Bias Then If Len(n.submatches(0)) Or n.Value = """""" Then v(c) = n.submatches(0)
      Next
    End If
  End With
  RExtract = v
End Function
Function ArrayID$(e)
    ArrayID = "(" & e & ")"
End Function
Function ReducePath$(key$)
    If InStr(key, ".") Then ReducePath = Left(key, InStrRev(key, ".") - 1) Else ReducePath = key
End Function
Function ListPaths(dic)
    Dim s$, v
    For Each v In dic
        s = s & v & " --> " & dic(v) & vbLf
    Next
    Debug.Print s
End Function
Function GetFilteredValues(dic, match)
    Dim c&, i&, v, w
    v = dic.keys
    ReDim w(1 To dic.Count)
    For i = 0 To UBound(v)
        If v(i) Like match Then
            c = c + 1
            w(c) = dic(v(i))
        End If
    Next
    ReDim Preserve w(1 To c)
    GetFilteredValues = w
End Function
Function GetFilteredTable(dic, cols)
    Dim c&, i&, j&, v, w, z
    v = dic.keys
    z = GetFilteredValues(dic, cols(0))
    ReDim w(1 To UBound(z), 1 To UBound(cols) + 1)
    For j = 1 To UBound(cols) + 1
         z = GetFilteredValues(dic, cols(j - 1))
         For i = 1 To UBound(z)
            w(i, j) = z(i)
         Next
    Next
    GetFilteredTable = w
End Function
Function OpenTextFile$(f)
    With CreateObject("ADODB.Stream")
        .Charset = "utf-8"
        .Open
        .LoadFromFile f
        OpenTextFile = .ReadText
    End With
End Function
voici un exemple d'utilisation pour extraire des données :
Code:
Sub Lire_sirene()
Dim Jsn As String, val As String, i As Integer
Dim DictJSON As Object
    On Error GoTo errhdlr
    With Sheets("Feuil1")
        For i = 2 To .Cells(Rows.Count, "A").End(xlUp).Row
            val = Format(.Cells(i, "A").Value, "000000000")
            With CreateObject("MSXML2.XMLHTTP")
              .Open "GET", BASE_SIRENE & val & "&limit=20", False
              .send
              Jsn = .responseText
            End With
            Set DictJSON = ParseJSON(Jsn)
            If Not DictJSON Is Nothing Then
                    .Cells(i, "B").Value = "'" & DictJSON("obj.results(0).codepostaletablissement")
                    .Cells(i, "C").Value = "'" & DictJSON("obj.results(0).libellecommuneetablissement")
                    .Cells(i, "D").Value = "'" & DictJSON("obj.results(0).siretsiegeunitelegale")
            End If
        Next i
    End With
    Exit Sub
errhdlr:
    MsgBox "Erreur : adresse URL à vérifier."
End Sub
La constante BASE_SIRENE du classeur fourni ici n'est pas bonne, utilisé celle du dernier classeur de p56.

Nullosse.
Bonjour @nullosse ,

Merci beaucoup pour le code !

Juste une petite question : est-ce que je dois simplement copier-coller ce nouveau code dans un module VBA, ou bien il remplace/modifie le code déjà existant ?

Je débute en VBA, donc je préfère être sûr 😊

Si jamais vous avez la possibilité de m’envoyer un fichier avec les modifications déjà intégrées pour que je puisse le tester directement, ce serait vraiment top !

Encore merci pour votre aide 🙏
 
Si jamais vous avez la possibilité de m’envoyer un fichier avec les modifications déjà intégrées pour que je puisse le tester directement, ce serait v=
En pièce jointe un classeur qui utilise le parseur VBA au lieu du parseur Javascript. L'Antivirus ne devrait plus se déclencher.
Il y a un problème avec les caractères accentués par exemple île de France devient \u00cele de France. Un décodage est nécessaire (peut-être déjà fait dans le forum).
 

Pièces jointes

Salut,
A essayer le classeur de crocrocro qui se trouve ici . Il est plus complet que le classeur du post #1.
Il utilise aussi du javascript mais d'une autre façon que le classeur du post #1. Voir si l'antivirus se déclenche en exécutant la macro.
Mon antivirus est windows defender sous windows 11 et ne se déclenche pas. Quel est l'antivirus qui déclenche au post #1 ?
Nullosse
 
Dernière édition:
En pièce jointe un classeur qui utilise le parseur VBA au lieu du parseur Javascript. L'Antivirus ne devrait plus se déclencher.
Il y a un problème avec les caractères accentués par exemple île de France devient \u00cele de France. Un décodage est nécessaire (peut-être déjà fait dans le forum).
Bonjour @nullosse,

La bonne nouvelle, c’est que mon antivirus ne le bloque pas, c’est déjà ça !

Le fichier fonctionne bien, mais je n’arrive pas à trouver sur le forum une solution au problème des caractères accentués — par exemple, Île-de-France devient \u00cele-de-France.



Un grand merci ! 😊
 
- Navigue sans publicité
- Accède à Cléa, notre assistante IA experte Excel... et pas que...
- Profite de fonctionnalités exclusives
Ton soutien permet à Excel Downloads de rester 100% gratuit et de continuer à rassembler les passionnés d'Excel.
Je deviens Supporter XLD

Discussions similaires

Réponses
16
Affichages
1 K
Réponses
13
Affichages
1 K
Réponses
1
Affichages
583
Retour