Conversion VBA 32bits en 64bits

Bonjour à toutes et tous,

je ne suis pas un as en vba. Nos excel entreprise sont passés de 32b à 64b.

Résultat, mes programmes ne fonctionnent plus ...

Voici mon 1er programme, quelqu'un pourrait-il m'aider ?

Option Explicit

'*************************************************
' DECLARATION DES VARIABLES PUBLIQUES
'*************************************************

Public Type BROWSEINFO
hOwner As Long
pidlRoot As Long
pszDisplayName As String
lpszTitle As String
ulFlags As Long
lpfn As Long
lParam As Long
iImage As Long
End Type

'32-bit API déclarations
Declare Function SHGetPathFromIDList Lib "shell32.dll" _
Alias "SHGetPathFromIDListA" (ByVal pidl As Long, ByVal pszPath As String) As Long
Declare Function SHBrowseForFolder Lib "shell32.dll" _
Alias "SHBrowseForFolderA" (lpBrowseInfo As BROWSEINFO) As Long

'***********************************************************************
' FONCTION PERMETTANT D'OUVRIR L'EXPLORATEUR ET AFFICHER LE NOM
' DU DOSSIER SELECTIONNE DANS LA FEUILLE.
'***********************************************************************

Function GetDirectory(Optional Msg) As String

'Déclaration des variables
Dim bInfo As BROWSEINFO
Dim path As String
Dim r As Long, x As Long, pos As Integer

On Error GoTo 1

bInfo.pidlRoot = 0&
If IsMissing(Msg) Then
bInfo.lpszTitle = "Veuillez sélectionner votre dossier."
Else
bInfo.lpszTitle = Msg
End If
bInfo.ulFlags = &H1
x = SHBrowseForFolder(bInfo)
path = Space$(512)
r = SHGetPathFromIDList(ByVal x, ByVal path)
If r Then
pos = InStr(path, Chr$(0))
GetDirectory = Left(path, pos - 1)
Range("a2") = GetDirectory
Else
GetDirectory = ""
End If
1
End Function

'***************************************************************************
' PROCEDURE PERMETTANT DE FAIRE APPEL A LA FONCTION
'***************************************************************************
Sub Appel()
'On mette en place une gestion des erreurs
On Error GoTo 1
Msg = "Veuillez sélectionner le dossier désiré"
'On appelle la fonction
ChDir GetDirectory(Msg)
1
End Sub

Merci d'avance.

Bon weekend à vous

Bonjour,

Remplace les déclarations par celles-ci :

#If VBA7 Then
    Private Type BROWSEINFO
        hOwner As LongPtr
        pidlRoot As LongPtr
        pszDisplayName As String
        lpszTitle As String
        ulFlags As Long
        lpfn As LongPtr
        lParam As LongPtr
        iImage As Long
    End Type

    Private Declare PtrSafe Function SHBrowseForFolder Lib "shell32.dll" Alias "SHBrowseForFolderA" _
        (lpBrowseInfo As BROWSEINFO) As LongPtr
#Else
    Private Type BROWSEINFO
        hOwner As Long
        pidlRoot As Long
        pszDisplayName As String
        lpszTitle As String
        ulFlags As Long
        lpfn As Long
        lParam As Long
        iImage As Long
    End Type

    Private Declare Function SHBrowseForFolder Lib "shell32.dll" Alias "SHBrowseForFolderA" _
        (lpBrowseInfo As BROWSEINFO) As Long
#End If
Private Const BIF_RETURNONLYFSDIRS = &H1

Pour le reste rien à changer...

Si tu es certain que ça ne tournera plus jamais sur la moindre bécane 32 bits tu peux même ne garder que ce qui est entre if et Else... mébon ça ne mange pas de pain de tout garder...

A+

EDIT : Je pense qu'on peux citer le lien pour tous les proplèmes de ce genre
Edit modo : non, il s'agit d'une société de service, merci de relire la charte

• Les liens considérés comme publicitaires sont interdits dans les messages (notez que vous pouvez faire un lien vers votre site par le biais du champ "Site Web" de votre profil si votre participation sur le forum est suffisante pour compléter ce champ).

Bonjour MLG et

Une petite présentation ICI serait la bienvenue

Je vous invite à lire la charte du forum [A LIRE AVANT DE POSTER] qui vous aidera dans vos demandes et réponses sur ce forum et notamment :

• Pour plus de lisibilité, utilisez la fonctionnalité pour insérer vos codes VBA (et si possible aussi pour vos formules Excel).

Concernant votre problématique,
à moins de vouloir faire des trucs tarabiscotés, une API est totalement inutile

Function ChoixDossier(DefautPath As String, sTitre As String)
  Dim fd As FileDialog
  Set fd = Application.FileDialog(msoFileDialogFolderPicker)
  With fd
    .Title = sTitre
    .InitialFileName = DefautPath
    If .Show = -1 Then
      ChoixDossier = fd.SelectedItems(1)
    End If
  End With
  Set fd = Nothing
End Function

Merci de votre participation

Cordialement