Adapter un code 32 bits en 64 bits

Bonjour tout le monde,

J'ai de nouveau besoin de vos compétences.

J'ai le code suivant qui détecte l'usurname et le numéro de serie du DD à l'ouverture du fichier excel :

Private Declare Function GetVolumeInformation Lib _
"Kernel32.dll" Alias "GetVolumeInformationA" (ByVal _
lpRootPathName As String, ByVal lpVolumeNameBuffer As _
String, ByVal nVolumeNameSize As Integer, _
lpVolumeSerialNumber As Long, _
lpMaximumComponentLength _
As Long, lpFileSystemFlags As Long, ByVal _
lpFileSystemNameBuffer As String, ByVal _
nFileSystemNameSize As Long) As Long

Function NumSerieDD(LettreDD As String) As Long
Dim SerialNum As Long
Dim R As Long
Dim Temp1 As String
Dim Temp2 As String
LettreDD = LettreDD & ":\"
Temp1 = String$(255, Chr$(0))
Temp2 = String$(255, Chr$(0))
R = GetVolumeInformation(LettreDD, Temp1, _
Len(Temp1), SerialNum, 0, 0, Temp2, Len(Temp2))
NumSerieDD = SerialNum
End Function

Il fonctionne très bien en 32bits. Je crois qu'il faut ajouter des "PtrSafe" pour qu'il fonctionne en 64 bits.

J'ai besoin que le code fonctionne sur 32 comme 64 bits.

Est ce que quelqu'un peut me l'adapter s'il vous plait.

Bonsoir Albatros182,

Pour le choix de la version 64 bits ou 32 bits

Faire le test avec VBA7 ou WIN64 qui aiguilleront vers la version 64 si le test est vrai (True)

Exemple:

' Version 64
If VBA7 then 
Private Declare Ptrsafe Function GetVolumeInformation Lib _...etc...        ' Note remplacer Long par PtrLong
.... suite du code....
Else
'Version 32
Private Declare Function GetVolumeInformation .... etc...
.... suite du code...
End if

Bons tests, bonne continuation.

Bonjour le fil

Désolé de contredire X Cellus, mais ce n'est pas Office qu'il faut vérifier si 32 ou 64 bits,

mais Windows, car on appelle les API Windows et on peut très bien installer un Office 32 bit sur un Windows 64

Il faut donc utiliser "Win64"

De plus les directives de compilation commencent toujours par #

#If Win64 Then
#Else
#End IF

Pour info

https://docs.microsoft.com/fr-fr/previous-versions/office/ee691831(v=office.14)?redirectedfrom=MSDN

@+

A nouveau,

@BrunoM45,

Exact pour les # que j'ai oublié.

Pour Win64, il est tellement peu utilisé que Vba7 fait quasiment l'affaire.

Voir le lien fourni.

Bonjour tout le monde et merci pour vos réponses.

Je me suis lancé dans l'adaptation du code.

Pouvez-vous me donnez votre avis?

Il fonctionne sur excel 32 bits. Est ce que quelqu'un peu faire un test sur excel 64 bits pour me dire si il fonctionne ?

Je n'ai pas d'excel 64 bits à la maison.

Se serait super sympa

Merci d'avance

Option Explicit

#If VBA7 Then
Private Declare PtrSafe Function GetVolumeInformation Lib _
"Kernel32.dll" Alias "GetVolumeInformationA" (ByVal _
lpRootPathName As String, ByVal lpVolumeNameBuffer As _
String, ByVal nVolumeNameSize As Integer, _
lpVolumeSerialNumber As LongPtr, _
lpMaximumComponentLength _
As LongPtr, lpFileSystemFlags As LongPtr, ByVal _
lpFileSystemNameBuffer As String, ByVal _
nFileSystemNameSize As LongPtr) As LongPtr

#Else
Private Declare Function GetVolumeInformation Lib _
"Kernel32.dll" Alias "GetVolumeInformationA" (ByVal _
lpRootPathName As String, ByVal lpVolumeNameBuffer As _
String, ByVal nVolumeNameSize As Integer, _
lpVolumeSerialNumber As Long, _
lpMaximumComponentLength _
As Long, lpFileSystemFlags As Long, ByVal _
lpFileSystemNameBuffer As String, ByVal _
nFileSystemNameSize As Long) As Long
#End If

Function NumSerieDD(LettreDD As String) As LongPtr
Dim SerialNum As LongPtr
Dim R As LongPtr
Dim Temp1 As String
Dim Temp2 As String
LettreDD = LettreDD & ":\"
Temp1 = String$(255, Chr$(0))
Temp2 = String$(255, Chr$(0))
R = GetVolumeInformation(LettreDD, Temp1, _
Len(Temp1), SerialNum, 0, 0, Temp2, Len(Temp2))
NumSerieDD = SerialNum
End Function

Sub Test_Info()
Range("D3") = Environ("Username")
Range("D4") = NumSerieDD("C")
End Sub

bonjour,

fonctionne chez moi ( windows 10-64 bits et office 365-64 bits)

Super, donc il devrait fonctionner sur excel 2016 64 bits ?

Merci de ta réponse, cela m'aide beaucoup.

Bonjour à tous,

Je confirme que cela fonctionne sur O365 64bit et donc forcément sur version antérieure

Merci à tous pour votre investissement.

À la prochaine.