Live-Forum - Die aktuellen Beiträge
Anzeige
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender

Forumthread: Excel 64-Bit - Problem API Dateiauswahl

Excel 64-Bit - Problem API Dateiauswahl
26.01.2013 23:52:37
SteffenS
Hallo Zusammen,
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

Anzeige

3
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
Nicht doppelt - anderer Dialog - Dateiauswahl
27.01.2013 10:26:36
SteffenS
Hallo,
der Thread ist nicht doppelt.
Einige Variablen werden nur in beiden Makros verwendet.
Dieses Problem betrifft den Dateiauswahldialog.
Vielleicht habt ihr noch eine Idee.
Danke Euch schonmal.
VG
Steffen Schmerler

Anzeige
Habs gelöst - Danke nochmal
27.01.2013 11:31:23
SteffenS
Hallo,
habe das Problem gelöst.
So funktionierts :-)

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
#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
Type OPENFILENAME
nStructSize     As LongPtr
hwndOwner       As LongPtr
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 LongPtr
sTemplateName   As String
End Type
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 = LenB(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
VG
Steffen
Anzeige
;
Anzeige
Anzeige

Infobox / Tutorial

Excel 64-Bit: API Dateiauswahl Problemlösung


Schritt-für-Schritt-Anleitung

Um den API-Dateiauswahldialog in Excel 64-Bit korrekt zu implementieren, befolge diese Schritte:

  1. VBA-Editor öffnen: Drücke ALT + F11, um den VBA-Editor zu öffnen.
  2. Modul erstellen: Klicke auf Einfügen > Modul, um ein neues Modul zu erstellen.
  3. Code einfügen: Füge den folgenden Code in das Modul ein. Achte darauf, die Declare-Anweisungen für 64-Bit zu verwenden:
Option Explicit
Option Compare Text

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

#If Win64 Then
Declare PtrSafe Function GetOpenFileName Lib "comdlg32.dll" Alias "GetOpenFileNameA" (pOpenfilename As OPENFILENAME) As Long
#Else
Declare Function GetOpenFileName Lib "comdlg32.dll" Alias "GetOpenFileNameA" (pOpenfilename As OPENFILENAME) As Long
#End If

Type OPENFILENAME
    nStructSize     As Long
    hwndOwner       As Long
    hInstance       As Long
    sFilter         As String
    nFilterIndex    As Long
    sFile           As String
    nFileSize       As Long
    sDlgTitle       As String
    Flags           As Long
End Type

Function API_Dateiausw(strInitDir As String) As String
    Dim uOFN As OPENFILENAME
    uOFN.nStructSize = Len(uOFN)
    uOFN.hwndOwner = Application.hWnd
    uOFN.sFilter = "Excel Dateien (*.xlsx)" & vbNullChar & "*.xlsx" & vbNullChar & vbNullChar
    uOFN.sDlgTitle = "Dateiauswahl"
    uOFN.Flags = OFN_EXPLORER Or OFN_LONGNAMES

    uOFN.sFile = Space$(260)
    uOFN.nFileSize = Len(uOFN.sFile)

    If GetOpenFileName(uOFN) Then
        API_Dateiausw = Left(uOFN.sFile, InStr(uOFN.sFile, vbNullChar) - 1)
    Else
        API_Dateiausw = ""
    End If
End Function
  1. Testen des Codes: Erstelle eine Subroutine, um die Funktion zu testen:
Sub TestDateiauswahl()
    Dim sFilepath As String
    sFilepath = API_Dateiausw(ThisWorkbook.Path)
    MsgBox sFilepath
End Sub
  1. Führe die Subroutine aus: Klicke im VBA-Editor auf Run oder drücke F5, um die Subroutine auszuführen und den Dateidialog zu testen.

Häufige Fehler und Lösungen

  • Der Dialog öffnet sich nicht: Überprüfe, ob du die Declare-Anweisungen für 64-Bit korrekt verwendet hast. Achte darauf, dass der Verweis auf comdlg32.dll korrekt ist.
  • Fehlermeldungen: Stelle sicher, dass alle benötigten Parameter in der Struktur OPENFILENAME korrekt gesetzt sind.
  • Falsche Dateitypen: Achte darauf, dass der Filter für die Dateiauswahl korrekt definiert ist.

Alternative Methoden

Wenn die API-Methoden nicht funktionieren, kannst du alternative Methoden wie den Application.FileDialog verwenden:

Sub FileDialogAlternative()
    Dim fd As FileDialog
    Set fd = Application.FileDialog(msoFileDialogFilePicker)

    If fd.Show = -1 Then
        MsgBox fd.SelectedItems(1)
    End If
End Sub

Diese Methode ist einfacher und benötigt keinen speziellen API-Code, funktioniert jedoch nur für die Dateiauswahl.


Praktische Beispiele

  1. Dateiauswahl mit spezifischem Filter: Ändere die Filterkriterien nach Bedarf, um nur bestimmte Dateitypen anzuzeigen, zum Beispiel:
uOFN.sFilter = "Excel Dateien (*.xls; *.xlsx)" & vbNullChar & "*.xls; *.xlsx" & vbNullChar & vbNullChar
  1. Verwendung von SHBrowseForFolder: Um einen Ordner auszuwählen, kannst du auch die Funktion SHBrowseForFolder verwenden:
Declare PtrSafe Function SHBrowseForFolder Lib "shell32.dll" Alias "SHBrowseForFolderA" (lpBrowseInfo As BROWSEINFO) As LongPtr

Tipps für Profis

  • Verwende Option Explicit: Dies hilft, Fehler durch nicht deklarierte Variablen zu vermeiden.
  • Debugging: Nutze Debug.Print und MsgBox, um Variablenwerte während der Ausführung zu überprüfen.
  • Verweise: Stelle sicher, dass alle benötigten Verweise in den Tools > Verweise im VBA-Editor aktiviert sind, besonders wenn du externe DLLs verwendest.

FAQ: Häufige Fragen

1. Was ist comdlg32.dll?
comdlg32.dll ist eine System-DLL, die für die Bereitstellung von Standard-Dialogfenstern in Windows verantwortlich ist, darunter auch den Dateiöffnen-Dialog.

2. Welche Excel-Version benötige ich für diese Funktionen?
Die beschriebenen Funktionen und APIs sind für Excel 2010 und neuere Versionen geeignet, insbesondere für die 64-Bit-Version.

3. Wie kann ich den Dateidialog für andere Dateiformate anpassen?
Ändere einfach den Filter in der sFilter-Eigenschaft der OPENFILENAME-Struktur, um andere Dateiformate zu unterstützen.

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Entdecke mehr
Finde genau, was du suchst

Die erweiterte Suchfunktion hilft dir, gezielt die besten Antworten zu finden

Suche nach den besten Antworten
Unsere beliebtesten Threads

Entdecke unsere meistgeklickten Beiträge in der Google Suche

Top 100 Threads jetzt ansehen
Anzeige