• Privacywetgeving
    Het is bij Helpmij.nl niet toegestaan om persoonsgegevens in een voorbeeld te plaatsen. Alle voorbeelden die persoonsgegevens bevatten zullen zonder opgaaf van reden verwijderd worden. In de vraag zal specifiek vermeld moeten worden dat het om fictieve namen gaat.

code aanpassen

Status
Niet open voor verdere reacties.
B

beertje

Gebruiker
Lid geworden
14 dec 2000
Berichten
491
Hallo,
Ik wil een excel bestand gaan gebruiken, alleen geeft hij aan dat ik een code moet wijzigen om hem te laten draaien onder een 64 bits systeem.
maar zou helemaal niet weten wat ik moet gaan wijzigen.
Wil iemand hier misschien even naar willen kijken..?
Alvast bedankt..

Bekijk bijlage mp3filelister.xls
 
Wijzig je API declaraties in dit, dan werkt het voor zowel 32- als 64-bit Office:
Code: 
'API declarations
#If VBA7 Then
    Declare PtrSafe Function SHGetPathFromIDList Lib "shell32.dll" _
      Alias "SHGetPathFromIDListA" (ByVal pidl As Long, ByVal pszPath As String) As LongPtr
      
    Declare PtrSafe Function SHBrowseForFolder Lib "shell32.dll" _
      Alias "SHBrowseForFolderA" (lpBrowseInfo As BROWSEINFO) As LongPtr

    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
#Else
    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

    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
#End If

@alphamax:
En inderdaad de UDT's er bij ;)
 
Laatst bewerkt:
Vervang
Code: 
[SIZE=1]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[/SIZE]
door
Code: 
[SIZE=1]#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

Private Declare PtrSafe Function SHGetPathFromIDList Lib "shell32.dll" Alias "SHGetPathFromIDListA" _
        (ByVal pidl As LongPtr, ByVal pszPath As String) As Boolean
#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

Private Declare Function SHGetPathFromIDList Lib "shell32.dll" Alias "SHGetPathFromIDListA" _
                                             (ByVal pidl As Long, ByVal pszPath As String) As Boolean
#End If
Private Const BIF_RETURNONLYFSDIRS = &H1[/SIZE]
bron: http://www.jkp-ads.com/articles/apideclarations.asp

@edmoor
Hoeft de type niet aangepast te worden?
 
Laatst bewerkt:
Heb je überhaupt wel een Office 64 Bit systeem ?
 
@Alphamax

krijg een foutmelding:
hij geeft aan:
Compiler Fout
Typen komen niet met elkaar overeen


Function GetDirectory(Optional Msg) As String
Dim bInfo As BROWSEINFO
Dim path As String
Dim r As Long, x As Long, pos As Integer
' Root folder = Desktop
bInfo.pidlRoot = 0&
' Title in the dialog
If IsMissing(Msg) Then
bInfo.lpszTitle = "Select a folder."
Else
bInfo.lpszTitle = Msg
End If
' Type of directory to return
bInfo.ulFlags = &H1
' Display the dialog
x = SHBrowseForFolder(bInfo)
' Parse the result
path = Space$(512)
r = SHGetPathFromIDList(ByVal x, ByVal path)
If r Then
pos = InStr(path, Chr$(0))
GetDirectory = Left(path, pos - 1)
Else
GetDirectory = ""
End If
End Function
 
Ik heb hier geen 64-bit Office dus kan het even niet testen. Morgen op m'n werkplek wel.
Laat ook eens zien hoe je functie declaratie er nu uitziet.
 
Bedoel je dit ??

'API declarations
#If VBA7 Then
Declare PtrSafe Function SHGetPathFromIDList Lib "shell32.dll" _
Alias "SHGetPathFromIDListA" (ByVal pidl As Long, ByVal pszPath As String) As LongPtr

Declare PtrSafe Function SHBrowseForFolder Lib "shell32.dll" _
Alias "SHBrowseForFolderA" (lpBrowseInfo As BROWSEINFO) As LongPtr

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
#Else
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

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
#End If
 
Gebruik AUB codetags voor het tonen van code hier.
 
Vervang
Code: 
Dim r As Long, x As Long, pos As Integer
door
Code: 
#If VBA7 Then
Dim r As Long, x As [COLOR="#FF0000"]LongPtr[/COLOR], pos As Integer
#Else
Dim r As Long, x As Long, pos As Integer
#End If
P.S voor het gebruik van codetags zie mijn handtekening.
 
Laatst bewerkt:
heb ik veranderd, krijg alleen nog het onderstaande fout.
de X op regel 22

Code: 
Function GetDirectory(Optional Msg) As String
    Dim bInfo As BROWSEINFO
    Dim path As String
    #If VBA7 Then
Dim r As Long, x As LongPtr, pos As Integer
#Else
#End If
'   Root folder = Desktop
    bInfo.pidlRoot = 0&
'   Title in the dialog
    If IsMissing(Msg) Then
        bInfo.lpszTitle = "Select a folder."
    Else
        bInfo.lpszTitle = Msg
    End If
'   Type of directory to return
    bInfo.ulFlags = &H1
'   Display the dialog
    x = SHBrowseForFolder(bInfo)
'   Parse the result
    path = Space$(512)
    r = SHGetPathFromIDList(ByVal x, ByVal path)
    If r Then
        pos = InStr(path, Chr$(0))
        GetDirectory = Left(path, pos - 1)
    Else
        GetDirectory = ""
  End If
End Function
 
Laatst bewerkt:
Ik zie geen foutmelding in je bericht, maar ik denk dat je met variabele r hetzelfde moet doen als variabele x.
Dat is helemaal niet moeilijk.
 
En weer niet de foutmelding er bij...
 
Daar volgt altijd een melding bij en daar gaat het me om.
 
Laatst bewerkt:
heb de X en de R op regel 22 omgedraaid, krijg nu geen foutmelding meer.
druk ik vervolgens op start krijg ik mooi het venster te zien om een directory te selecteren en zo naar de dir te gaan waar de mp3's in staan
maar helaas dan doet ie verder niets meer, dus weet niet wat er verder mee aan de hand is.
maar als het verder te ingewikkeld wordt, ga ik opzoek naar iets anders.
 
Als je een Office versie hoger 2003 gebruikt, sla dan je document eens op als .xlsm
Dan draait hij in ieder geval niet in compatibiliteitsmodus.
 
Wijzig die GetDirectory functie eens in dit:
Code: 
Function GetDirectory(Optional Msg) As String
    GetDirectory = "C:\MP3"
End Function

Waarbij je uiteraard C:\MP3 wijzigt in een folder waar je MP3 bestanden hebt staan.
 
edmoor zei:
Wijzig die GetDirectory functie eens in dit:
Code: 
Function GetDirectory(Optional Msg) As String
    GetDirectory = "C:\MP3"
End Function

Waarbij je uiteraard C:\MP3 wijzigt in een folder waar je MP3 bestanden hebt staan.
Klik om te vergroten...

Helaas Edmoor, nog steeds niets :(
 
Status
Niet open voor verdere reacties.
Steun Ons

Nieuwste berichten

Terug
Bovenaan Onderaan