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 :
Code:
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
| 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.
Merci d'avance.
Adapter un code 32 bits en 64 bits
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
Code:
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
|
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 |
