Trouver adresse mac du PC avant l'ouverture du fichier Excel via une Macro

Le 09/10/2022 à 00:17

Bonjour à tous,

Voilà après autant de recherche sur google rien de solide. Mais je sollicite vos aides pour cette fameuse macro.

Je souhaite créer une macro qui s'auto-exécute à l'ouverture du fichier Excel permettant de vérifier l’adresse MAC prédéfinie d’un d’ordinateur (filaire ou wifi) qui trouve et compare à celui qu'on a indiqués dans la macro dont à l'ouverture du fichier si la macro ne trouve pas l'adresse MAC du PC concerné alors le fichier ne devrait pas s'ouvrir.

Je viens de trouver sur ce macro mais pas possible de la faire fonctionner. J'ai essayé mais je reçois le message le fichier non trouvé.

14macro5.xlsm (19.01 Ko)
Private Sub auto_close()

   Sheets("Feuil1").Visible = False
   Sheets("Feuil2").Visible = True
   Sheets("Feuil3").Visible = False

End Sub
Private Sub auto_open()
Dim MotdePassevrai As String
Dim MotdePasseboite As String
Dim Comp As Integer
Dim Verif As String

Comp = 1

Verif = MacAddress1

MsgBox Verif

    Verif = Replace(Verif, " ", "")
    Trim (Verif)

Select Case Verif
Case "17-62-56-CE-2E-A9"
   MsgBox "Coucou"
   Sheets("Feuil1").Visible = True
   Sheets("Feuil2").Visible = False
   Sheets("Feuil3").Visible = True

Case "40-E8-32-A3-F2-B4"  '(wifi)

   MsgBox "blabla Geli"
   Sheets("Feuil1").Visible = True
   Sheets("Feuil2").Visible = False
   Sheets("Feuil3").Visible = True

Case Else
   MotdePassevrai = "oui"
   MotdePasseboite = "non"
   For x = 1 To 3

      If MotdePasseboite <> MotdePassevrai Then
        MotdePasseboite = InputBox("Tapez le mot de passe essai " & Comp)
        GoTo Suite
      Else
       Comp = Comp + 1
       End If
   Next x

   If Comp = 3 Then
      ActiveWorkbook.Close False
   End If
Suite:
   Sheets("Feuil1").Visible = True
   Sheets("Feuil2").Visible = False
   Sheets("Feuil3").Visible = True

End Select

End Sub
 '-------------------------------------

Function MacAddress1()

Dim A As String
Dim Ligne As String
Dim Fichier1 As String
Dim T As String

'Crée le fichier avec toutes les info...
 Fichier1 = "c:\MacGeli1.txt"
 commande = Environ("comspec") & _
 " /c " & "ipconfig /all > " & Fichier1 & """"
 ret = Shell(commande, 1)

A = FreeFile
 Open Fichier1 For Input As #A
' Open Fichier1 For Input Access Read As #A

Do While Not EOF(A)
 Line Input #A, Ligne
 T = WorksheetFunction.Substitute(Ligne, "-", "")
 If Len(Ligne) - Len(T) = 5 Then
 MacAddress1 = Mid(Ligne, InStr(1, Ligne, ":", _
 vbTextCompare) + 1, 20)
 Exit Do
 End If
 Loop
 Close #A
 Kill Fichier1

End Function

Merci d'avance.

Le 09/10/2022 à 00:37

bonsoir,

essaie avec ce code, correction de la commande + mettre le fichier dans un autre répertoire.

Function MacAddress1()

Dim A As String
Dim Ligne As String
Dim Fichier1 As String
Dim T As String

'Crée le fichier avec toutes les info...
 Fichier1 = "D:\downloads\MacGeli1.txt"
 commande = Environ("comspec") & _
 " /c " & "ipconfig /all >" & Fichier1
 ret = Shell(commande, 1)

A = FreeFile
 Open Fichier1 For Input As #A
' Open Fichier1 For Input Access Read As #A

Do While Not EOF(A)
 Line Input #A, Ligne
 T = WorksheetFunction.Substitute(Ligne, "-", "")
 If Len(Ligne) - Len(T) = 5 Then
 MacAddress1 = Mid(Ligne, InStr(1, Ligne, ":", _
 vbTextCompare) + 1, 20)
 Exit Do
 End If
 Loop
 Close #A
 Kill Fichier1

End Function
Le 09/10/2022 à 01:44

Bonsoir,

Je n'ai pas un deuxième disque dur mais rien que le "C:", je viens d'essayer mais déjà à l'ouverture du fichier me donne "erreur 53" fichier introuvable.

erreur 53

puis après le débogueur VBA me donne ce code; "Open Fichier1 For Input As #A"

input error

Merci

A+

PS: Je ne sais pas si tu peux essayer ce fichier avec ton adresse mac pour voir si la macro s'exécute correctement peut être que je fais une erreur.

Le 09/10/2022 à 10:33

bonjour,

essaie le code que j'ai mis (tu n'as pas tenu compte de mes corrections), mais avec ton nom de fichier (le répertoire doit exister !). Le code que j'ai mis fonctionne chez moi.

Le 09/10/2022 à 11:28

Bonjour,

Super! Merci. En espérant que je le fais fonctionner chez moi. Mais j'aurai besoin que tu me guide, car le code que tu m'as transmis je l'ai appliqué à la lettre mais où je fais l'erreur, pourquoi je dois créer un répertoire le code ne le créer pas qui est un fichier txt nommé MacGeli1.txt

Si tu peux m'éclairer étapes par étapes car je pense que je manque d' O2 dois-je créer un dossier (répertoire) ou un fichier txt (si oui dois-je écrire qqch dans le fichier txt)

Voici mon adresse MAC: 1 ) 17-62-56-CE-2E-A9 2) 40-E8-32-A3-F2-B4
Le nom de mon fichier chez moi s'appel test_MacID.xlsm que dois-je faire.

Merci

A+

Le 09/10/2022 à 12:36

bonjour,

Pour trouver la première adresse mac de ton PC, la fonction macaddress1 exécute la commande DOS "ipconfig /all" et écrit le résultat dans un fichier, dont tu as mis le chemin complet (disque+repertoire+nom) dans la variable fichier1 de la fonction VBA.

Pour pouvoir mettre ce résultat dans ce fichier, il faut que la macro puisse avoir accès au répertoire dans lequel tu lui as indiqué qu'il fallait écrire le fichier. (Pour cela, il faut que le répertoire existe et qu'il ne soit pas protégé contre l'écriture, apparemment l'accès à la racine c:\ est protégé chez toi). Tu dois donc indiquer un répertoire qui existe et qui n'est pas protégé contre l'écriture.

Ensuite la fonction ouvre ce fichier résultat et en extrait la première adresse MAC qu'elle trouve, supprime ce fichier résultat et renvoie l'adresse mac trouvée. Tu peux donc donner le nom que tu veux pour ce fichier, mais assure-toi de lui donner un nom d'un fichier qui n'existe pas et qui n'a aucune chance d'être le même qu'un fichier que tu pourrais créer dans le futur, pour un autre usage que cette fonction. Je pense que le nom MacGeli.txt répond à ce critère.

pourquoi je dois créer un répertoire le code ne le créer pas qui est un fichier txt nommé MacGeli1.txt

La fonction ne crée pas le répertoire (directory), il doit donc exister pour que la macro fonctionne. Par contre, la macro crée bien le fichier s'il n'existe pas, l'écrase si il existe et dans tous les cas le supprime à la fin de de la fonction.

Une adresse MAC est unique et liée à une interface réseau. Un PC peut en avoir plusieurs (ethernet, wifi, bluetooth, Infrarouge, ...). La fonction te renvoie la première adresse trouvée.

test_MacID.xlsm est le nom du classeur excel qui contient Ta macro et la fonction, et est un fichier distinct de celui utilisé par la fonction (nom donné dans la variable fichier1).

Le 09/10/2022 à 12:47

Bonjour le fil

Sinon un code pour récupérer l'adresse MAC d'un PC

Public Function GetMacAddress()
  Dim objNetwork As Object
  Dim strNetworkSql As String
  Dim strMacAdr As String

  strNetworkSql = "SELECT * FROM Win32_NetworkAdapter WHERE MACAddress IS NOT NULL"
  For Each objNetwork In GetObject("winmgmts:").ExecQuery(strNetworkSql)
    strMacAdr = objNetwork.MACAddress
    If strMacAdr <> "" Then Exit For
  Next
  GetMacAddress = strMacAdr
End Function

Edit mauvais code donné, y'a plus simple

A+

Le 09/10/2022 à 13:28

Bonjour à tous,

Je vais essayer de faire par le plus simple mais si non je voudrais bien tester le code de BrunoM45 mais pas mal de config à refaire et comment l'adapter à un classeur faut-il aussi créer un dossier avec un fichier ?

Merci

A+

Le 09/10/2022 à 13:58

re-bonjour,

voici le code adapté pour que tu n'aies plus à te soucier de quoi que ce soit. la fonction utilise le répertoire "temp" de ton PC et crée un fichier dont le nom est unique dans le temps. Il n'y a donc pas de pré-requis pour pouvoir l'utiliser.

Function MacAddress1()

    Dim A As String
    Dim Ligne As String
    Dim Fichier1 As String
    Dim T As String

    'Crée le fichier avec toutes les info...
    Fichier1 = Environ("TEMP") & "\macadress" & Format(Now, "yyyymmddhhmmss") & ".txt"
    commande = Environ("comspec") & _
    " /c " & "ipconfig /all >" & Fichier1
    ret = Shell(commande, 1)
    Application.Wait (Now + TimeValue("0:00:02"))
    A = FreeFile
    Open Fichier1 For Input As #A
    ' Open Fichier1 For Input Access Read As #A

    Do While Not EOF(A)
        Line Input #A, Ligne
        T = WorksheetFunction.Substitute(Ligne, "-", "")
        If Len(Ligne) - Len(T) = 5 Then
            MacAddress1 = Mid(Ligne, InStr(1, Ligne, ":", _
            vbTextCompare) + 1, 20)
            Exit Do
        End If
    Loop
    Close #A
    Kill Fichier1

End Function

Sub test()
    MsgBox MacAddress1
End Sub
Le 09/10/2022 à 20:55

Bonsoir,

Sans aucun fichier créé et avec auto_open et auto_close supprimé (alerte antivirus)

29kevin38-getmacadress.xlsm (20.63 Ko)

A+

Le 09/10/2022 à 21:30

Bonsoir BrunoM45,

un TOUT GRAND MERCI

Super la macro fonctionne très très bien, à l'ouverture du classeur une fenêtre d'alerte s'ouvre en indiquant l'adresse MAC du PC jusqu'à la tout va SUPER! .

J'aurai une demande si possible faire une comparaissions d'adresse mac du PC.
C'est à dire à l'ouverture si l'adresse mac trouvée ( le popup) ne correspond pas à celle qui se trouve dans le code le classeur ne s'ouvre et le fichier Excel se ferme d'elle même.

Dans mon exemple ici les Cases doit correspondre à celle de l'ouverture sinon bye bye l'ouverture (ainsi si ce fichier se balade sur un autre PC ne s'ouvre pas)
(les autres en dehors de la comparaison on peut tout supprimer càd le mot de passe, les pages masquées ou affichées etc. ainsi un code plus court et efficace je pense.)

Private Sub Workbook_Open()
Dim MotdePassevrai As String
Dim MotdePasseboite As String
Dim Comp As Integer
Dim Verif As String
Dim X As Integer

Comp = 1
Verif = GetMacAddress
MsgBox Verif
Verif = Replace(Verif, " ", "")
Trim (Verif)

Select Case Verif
Case "17-62-56-CE-2E-A9"
MsgBox "Coucou"
Sheets("Feuil1").Visible = True
Sheets("Feuil2").Visible = True
Sheets("Feuil3").Visible = True

Case "40-E8-32-A3-F2-B4" '(wifi)

MsgBox "blabla Geli"
Sheets("Feuil1").Visible = True
Sheets("Feuil2").Visible = True
Sheets("Feuil3").Visible = True

.........

Merci merci merci

A+

Le 10/10/2022 à 10:16

Bonjour Kevin38

Voici le fichier avec le code modifié, le classeur ne s'ouvrira que si 1 des 2 adresses MAC est bonne

35kevin38-getmacadress.xlsm (24.31 Ko)

Nota : on peut malgré tout forcer l'ouverture du fichier si on maintien la touche MAJ appuyée

A+

Le 10/10/2022 à 13:08

Bonjour BrunoM45,

Franchement! un TOUT GRAND MERCI la macro fonctionne très bien,

Est-ce que y a t il le moyen de désactiver "forcer l'ouverture du fichier si on maintien la touche MAJ appuyée" ?
Aussi ici le test se fait que sur 3 feuilles mais moi j'en ai 25 dois-je le rentrer un par un ou y at il une autre solution car mon "Thisworkbook" sera longue

Encore une fois un grand MERCI à Vous,

Bien cordialement,

A+

Le 11/10/2022 à 14:09

Bonjour Kevin38

Est-ce que y a t il le moyen de désactiver "forcer l'ouverture du fichier si on maintien la touche MAJ appuyée" ?

Non, il n'y a pas moyen et heureusement, c'est une sécurité

Vous ne voulez quand même pas demander le MdP 25 fois ou plus

Quel le but exacte de ça ?

A+

Le 11/10/2022 à 14:30

Bonjour BrunoM45,

Non bien évidement ce n'est pas le but ici, mais c'était juste au niveau de "Thisworkbook" dois-je entrer toutes mes feuilles?

Mais je me demandai s il y a vraiment pas le moyen de contourner cette sécurité de MAJ enfoncée ?

Si non rien à dire.

Merci

A+

Le 11/10/2022 à 14:50

Re,

Pour la MAJ enfoncée, je le répète, non ce n'est pas possible et heureusement

En revanche, je pense savoir ou tu veux en venir
Essayes d'ouvrir ce fichier avec la touche MAJ enfoncée

23kevin38-accueiletfeuillesmasquees.xlsm (26.43 Ko)

A+

Le 11/10/2022 à 20:16

Merci BrunoM45,

L'activation des macros c'était déjà OK. Je te remercie pour ton aide précieux et pour le temps consacré.

Kevin

A+

Rechercher des sujets similaires à "trouver adresse mac ouverture fichier via macro"