Excel 64-Bit - Problem API Dateiauswahl
26.01.2013 23:52:37
SteffenS
ich habe bisher zum Öffnen bestimmter Dateien nachfolgenden Code verwendet.
Bis Excel 2010 32-Bit funktioniert dieser auch einwandfrei.
Bei Excel 2010 64-Bit öffnet sich leider der Dateidialog nicht mehr.
Was muss ich tun, damit mein Code funktioniert?
Option Explicit
Option Compare Text
'API - Dateiauswahl-Dialog--------------------------------------------------------
Const OFN_READONLY As Long = &H1
Const OFN_EXPLORER As Long = &H80000
Const OFN_LONGNAMES As Long = &H200000
Const OFN_CREATEPROMPT As Long = &H2000
Const OFN_NODEREFERENCELINKS As Long = &H100000
Const OFN_OVERWRITEPROMPT As Long = &H2
Const OFN_HIDEREADONLY As Long = &H4
Const OFS_FILE_OPEN_FLAGS As Long = OFN_EXPLORER _
Or OFN_LONGNAMES _
Or OFN_CREATEPROMPT _
Or OFN_NODEREFERENCELINKS
Const OFS_FILE_SAVE_FLAGS As Long = OFN_EXPLORER _
Or OFN_LONGNAMES _
Or OFN_OVERWRITEPROMPT _
Or OFN_HIDEREADONLY
Type OPENFILENAME
nStructSize As Long
hwndOwner As Long
hInstance As Long
sfilter As String
sCustomFilter As String
nCustFilterSize As Long
nFilterIndex As Long
sFile As String
nFileSize As Long
sFileTitle As String
nTitleSize As Long
sInitDir As String
sDlgTitle As String
Flags As Long
nFileOffset As Integer
nFileExt As Integer
sDefFileExt As String
nCustData As Long
fnHook As Long
sTemplateName As String
End Type
#If Win64 Then
Declare PtrSafe Function GetActiveWindow Lib "user32.dll" () As Long
Declare PtrSafe Function GetOpenFileName Lib "comdlg32.dll" Alias "GetOpenFileNameA" ( _
pOpenfilename As OPENFILENAME) As Long
Declare PtrSafe Function GetSaveFileName Lib "comdlg32.dll" Alias "GetSaveFileNameA" ( _
pOpenfilename As OPENFILENAME) As Long
Declare PtrSafe Function GetShortPathName Lib "kernel32.dll" Alias "GetShortPathNameA" ( _
ByVal lpszLongPath As String, ByVal lpszShortPath As String, ByVal cchBuffer As Long) As Long
Declare PtrSafe Function GetDiskFreeSpace Lib "kernel32" Alias "GetDiskFreeSpaceA" (ByVal _
_
lpRootPathName As String, lpSectorsPerCluster As Long, lpBytesPerSector As Long, _
lpNumberOfFreeClusters As Long, lpTotalNumberOfClusters As Long) As Long
Declare PtrSafe Function SHGetPathFromIDList Lib "shell32.dll" Alias "SHGetPathFromIDListA" _
_
(ByVal pidl As Long, ByVal pszPath As String) As Long
'Declare PtrSafe Function SHBrowseForFolder Lib "shell32.dll" Alias "SHBrowseForFolderA" ( _
_
lpBrowseInfo As BROWSEINFO) As Long
Declare PtrSafe Function SHBrowseForFolder Lib "shell32.dll" Alias "SHBrowseForFolderA" ( _
lpBrowseInfo As BROWSEINFO) As LongPtr
Private Type BROWSEINFO
hOwner As LongPtr
pidlRoot As Long
pszDisplayName As String
lpszTitle As String
ulFlags As Long
lpFn As LongPtr
lParam As LongPtr
iImage As Long
End Type
#Else
Declare Function GetActiveWindow Lib "user32.dll" () As Long
Declare Function GetOpenFileName Lib "comdlg32.dll" Alias "GetOpenFileNameA" (pOpenfilename _
_
As OPENFILENAME) As Long
Declare Function GetSaveFileName Lib "comdlg32.dll" Alias "GetSaveFileNameA" (pOpenfilename _
_
As OPENFILENAME) As Long
Declare Function GetShortPathName Lib "kernel32.dll" Alias "GetShortPathNameA" (ByVal _
lpszLongPath As String, ByVal lpszShortPath As String, ByVal cchBuffer As Long) As Long
Declare Function GetDiskFreeSpace Lib "kernel32" Alias "GetDiskFreeSpaceA" (ByVal _
lpRootPathName As String, lpSectorsPerCluster As Long, lpBytesPerSector As Long, _
lpNumberOfFreeClusters As Long, lpTotalNumberOfClusters As Long) As Long
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
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
#End If
'API - Dateiauswahl-Dialog--------------------------------------------------------
Function API_Dateiasw(art As Long, strInitDir As String) As String
Dim sfilter As String
'// Strukturvariable vom Typ OPENFILENAME erzeugen
Dim uOFN As OPENFILENAME
'// Strukturgröße und Elternfenster setzen
10 uOFN.nStructSize = Len(uOFN)
20 uOFN.hwndOwner = GetActiveWindow()
'// Filter setzen und Index auf 2 (Datenbanken) setzen
'// Format: "Name" \n "Ext." \n "Name" \n "Ext." ... \n\n
'setzen des Filters
sfilter = "Importdateien (*" & ".xlsx" & ")" & vbNullChar & "*" & ".xlsx" & "" & _
vbNullChar
80 sfilter = sfilter & vbNullChar & vbNullChar
90 uOFN.sfilter = sfilter
100 uOFN.nFilterIndex = 2
'// Dialogtitel setzen
110 uOFN.sDlgTitle = "Dateiauswahl Importdatei:"
'// Flags setzen
120 uOFN.Flags = OFS_FILE_OPEN_FLAGS
'// Speicher für sFile und sFileTitle reservieren
130 uOFN.sFile = Space$(256) & vbNullChar
140 uOFN.sInitDir = strInitDir
150 uOFN.nFileSize = Len(uOFN.sFile)
160 uOFN.sFileTitle = Space$(256) & vbNullChar
170 uOFN.nTitleSize = Len(uOFN.sFileTitle)
'// Funktion aufrufen und auswerten
180 If GetOpenFileName(uOFN) Then
190 API_Dateiasw = Left(uOFN.sFile, InStr(uOFN.sFile, vbNullChar) - 1)
200 Else
'sFilepath = ""
210 End If
End Function
Sub test123()
Dim sFilepath As String
sFilepath = API_Dateiasw(1, ThisWorkbook.Path)
MsgBox (sFilepath)
End Sub
Danke Euch schonmal.
Steffen Schmerler