|
22.06.2010, 12:50 | #1 |
Frage - Filebrowser von XP unter Vista/Win7 - möglich?
Habe nicht ich geschrieben, aber das API/Modul hier funktioniert unter XP ganz gut:
Code: Option Explicit Type thOPENFILENAME lStructSize As Long hwndOwner As Long hInstance As Long strFilter As String strCustomFilter As String nMaxCustFilter As String nFilterIndex As Long strFile As String nMaxFile As Long strFileTitle As String nMaxFileTitle As Long strInitialDir As String strTitle As String Flags As Long nFileOffset As Integer nFileExtension As Integer strDefExt As String lCustData As Long lpfnHook As Long lpTemplateName As String End Type Declare Function th_apiGetOpenFileName Lib "comdlg32.dll" Alias "GetOpenFileNameA" (OFN As thOPENFILENAME) As Boolean Declare Function th_apiGetSaveFileName Lib "comdlg32.dll" Alias "GetSaveFileNameA" (OFN As thOPENFILENAME) As Boolean Declare Function CommDlgExtendetError Lib "commdlg32.dll" () As Long Private Const thOFN_READONLY = &H1 Private Const thOFN_OVERWRITEPROMPT = &H2 Private Const thOFN_HIDEREADONLY = &H4 Private Const thOFN_NOCHANGEDIR = &H8 Private Const thOFN_SHOWHELP = &H10 Private Const thOFN_NOVALIDATE = &H100 Private Const thOFN_ALLOWMULTISELECT = &H200 Private Const thOFN_EXTENSIONDIFFERENT = &H400 Private Const thOFN_PATHMUSTEXIST = &H800 Private Const thOFN_FILEMUSTEXIST = &H1000 Private Const thOFN_CREATEPROMPT = &H2000 Private Const thOFN_SHAREWARE = &H4000 Private Const thOFN_NOREADONLYRETURN = &H8000 Private Const thOFN_NOTESTFILECREATE = &H10000 Private Const thOFN_NONETWORKBUTTON = &H20000 Private Const thOFN_NOLONGGAMES = &H40000 Private Const thOFN_EXPLORER = &H80000 Private Const thOFN_NODEREFERENCELINKS = &H100000 Private Const thOFN_LONGNAMES = &H200000 Function GetOpenFile(Optional varDirectory As Variant, Optional varTitleForDialog As Variant) As Variant Dim strFilter As String Dim lngFlags As Long Dim varFileName As Variant lngFlags = thOFN_FILEMUSTEXIST Or thOFN_HIDEREADONLY Or thOFN_NOCHANGEDIR If IsMissing(varDirectory) Then varDirectory = "" If IsMissing(varTitleForDialog) Then varTitleForDialog = "" strFilter = thAddFilterItem(strFilter, "Excel (*.xls)", "*.XLS") varFileName = thCommonFileOpenSave(OpenFile:=True, InitialDir:=varDirectory, Filter:=strFilter, Flags:=lngFlags, DialogTitle:=varTitleForDialog) If Not IsNull(varFileName) Then varFileName = TrimNull(varFileName) GetOpenFile = varFileName End Function Public Function thCommonFileOpenSave(Optional ByRef Flags As Variant, Optional ByVal InitialDir As Variant, Optional ByVal Filter As Variant, _ Optional ByVal FilterIndex As Variant, Optional ByVal DefaultEx As Variant, Optional ByVal fileName As Variant, _ Optional ByVal DialogTitle As Variant, Optional ByVal hwnd As Variant, Optional ByVal OpenFile As Variant) As Variant Dim OFN As thOPENFILENAME Dim strFileName As String Dim FileTitle As String Dim fResult As Boolean If IsMissing(InitialDir) Then InitialDir = CurDir If IsMissing(Filter) Then Filter = "" If IsMissing(FilterIndex) Then FilterIndex = 1 If IsMissing(Flags) Then Flags = 0& If IsMissing(DefaultEx) Then DefaultEx = "" If IsMissing(fileName) Then fileName = "" If IsMissing(DialogTitle) Then DialogTitle = "" If IsMissing(hwnd) Then hwnd = 0 If IsMissing(OpenFile) Then OpenFile = True strFileName = Left(fileName & String(256, 0), 256) FileTitle = String(256, 0) With OFN .lStructSize = Len(OFN) .hwndOwner = hwnd .strFilter = Filter .nFilterIndex = FilterIndex .strFile = strFileName .nMaxFile = Len(strFileName) .strFileTitle = FileTitle .nMaxFileTitle = Len(FileTitle) .strTitle = DialogTitle .Flags = Flags .strDefExt = DefaultEx .strInitialDir = InitialDir .hInstance = 0 .lpfnHook = 0 .strCustomFilter = String(255, 0) .nMaxCustFilter = 255 End With If OpenFile Then fResult = th_apiGetOpenFileName(OFN) Else fResult = th_apiGetSaveFileName(OFN) If fResult Then If Not IsMissing(Flags) Then Flags = OFN.Flags thCommonFileOpenSave = TrimNull(OFN.strFile) Else thCommonFileOpenSave = vbNullString End If End Function Public Function thAddFilterItem(strFilter As String, strDescription As String, Optional varItem As Variant) As String If IsMissing(varItem) Then varItem = "*.*" thAddFilterItem = strFilter & strDescription & vbNullChar & varItem & vbNullChar End Function Private Function TrimNull(ByVal strItem As String) As String Dim intPos As Integer intPos = InStr(strItem, vbNullChar) If intPos > 0 Then TrimNull = Left(strItem, intPos - 1) Else TrimNull = strItem End If End Function Unter Vista (und 7) passiert aber genau nichts... sind die DLLs nicht mehr verfügbar, oder wie kommt das zustande? :/ |
|
22.06.2010, 14:59 | #2 |
MOF Guru |
Hallo Flutlicht,
die eigentliche Frage kann ich dir nicht beantworten. Aber wenn ich mich nicht irre, entspricht das in der Funktionalität den VBA-Methoden Application.GetOpenFilename bzw. Application.GetSaveAsFilename. Falls ja, könntest du diese an Stelle der API-Funktion verwenden. Schau dir das doch mal in der VBA-Hilfe an. Gruß Ingolf |
22.06.2010, 21:36 | #3 |
MOF Meister |
Hallo,
das läuft bei mir sowohl unter Vista wie Windows 7 ohne Probleme. Nur unter Excel 2010 64 Bit sind ein paar Anpassungen vorzunehmen. Aber dann läuft es auch da. Hier der Dialog mit deinem Code unter Windows 7 mit Excel 2007: |
22.06.2010, 21:43 | #4 |
MOF Meister |
Hallo!
Würdest Du mir/uns die Anpassungen verraten? Interessiert mich sehr. Danke! Gruß, René |
23.06.2010, 09:37 | #5 |
Hallo, Bin zu einem Kollegen (Vista64+Excel2003) - nichts passiert :/ |
|
23.06.2010, 09:40 | #6 |
Hallo Flutlicht, BIS JETZT wusste ich nicht, dass es sowas mit an Board gibt... Danke, du hast mich gerettet Sie müssen erst einige Beiträge anderer Benutzer bewertet haben, bevor Sie IngGi erneut bewerten können. Geändert von Flutlicht (23.06.2010 um 09:51 Uhr). |
|
23.06.2010, 17:55 | #7 |
MOF Meister |
Hallo,
hier der geänderte Code für Windows 7 & Excel 2010 64 Bit: Type thOPENFILENAME lStructSize As Long hwndOwner As LongPtr hInstance As LongPtr strFilter As String strCustomFilter As String nMaxCustFilter As Long nFilterIndex As Long strFile As String nMaxFile As Long strFileTitle As String nMaxFileTitle As Long strInitialDir As String strTitle As String flags As Long nFileOffset As Integer nFileExtension As Integer strDefExt As String lCustData As Long lpfnHook As LongPtr lpTemplateName As String End Type Private Declare PtrSafe Function th_apiGetOpenFileName Lib "comdlg32.dll" Alias "GetOpenFileNameA" (OFN As thOPENFILENAME) As LongLong Private Declare PtrSafe Function th_apiGetSaveFileName Lib "comdlg32.dll" Alias "GetSaveFileNameA" (OFN As thOPENFILENAME) As LongLong Private Declare PtrSafe Function CommDlgExtendetError Lib "commdlg32.dll" () As LongLong Private Const thOFN_READONLY = &H1 Private Const thOFN_OVERWRITEPROMPT = &H2 Private Const thOFN_HIDEREADONLY = &H4 Private Const thOFN_NOCHANGEDIR = &H8 Private Const thOFN_SHOWHELP = &H10 Private Const thOFN_NOVALIDATE = &H100 Private Const thOFN_ALLOWMULTISELECT = &H200 Private Const thOFN_EXTENSIONDIFFERENT = &H400 Private Const thOFN_PATHMUSTEXIST = &H800 Private Const thOFN_FILEMUSTEXIST = &H1000 Private Const thOFN_CREATEPROMPT = &H2000 Private Const thOFN_SHAREWARE = &H4000 Private Const thOFN_NOREADONLYRETURN = &H8000 Private Const thOFN_NOTESTFILECREATE = &H10000 Private Const thOFN_NONETWORKBUTTON = &H20000 Private Const thOFN_NOLONGGAMES = &H40000 Private Const thOFN_EXPLORER = &H80000 Private Const thOFN_NODEREFERENCELINKS = &H100000 Private Const thOFN_LONGNAMES = &H200000 Function GetOpenFile(Optional varDirectory As Variant, Optional varTitleForDialog As Variant) As Variant Dim strFilter As String Dim lngFlags As Long Dim varFileName As Variant lngFlags = thOFN_FILEMUSTEXIST Or thOFN_HIDEREADONLY Or thOFN_NOCHANGEDIR If IsMissing(varDirectory) Then varDirectory = "" If IsMissing(varTitleForDialog) Then varTitleForDialog = "" strFilter = thAddFilterItem(strFilter, "Excel (*.xls)" & vbNullChar & "*.XLS") varFileName = thCommonFileOpenSave(OpenFile:=True, InitialDir:=varDirectory, Filter:=strFilter, flags:=lngFlags, DialogTitle:=varTitleForDialog) If Not IsNull(varFileName) Then varFileName = TrimNull(varFileName) GetOpenFile = varFileName End Function Public Function thCommonFileOpenSave(Optional ByRef flags As Variant, Optional ByVal InitialDir As Variant, Optional ByVal Filter As Variant, _ Optional ByVal FilterIndex As Variant, Optional ByVal DefaultEx As Variant, Optional ByVal fileName As Variant, _ Optional ByVal DialogTitle As Variant, Optional ByVal hwnd As Variant, Optional ByVal OpenFile As Variant) As Variant Dim OFN As thOPENFILENAME Dim strFileName As String Dim FileTitle As String Dim fResult As Boolean If IsMissing(InitialDir) Then InitialDir = CurDir If IsMissing(Filter) Then Filter = "" If IsMissing(FilterIndex) Then FilterIndex = 1 If IsMissing(flags) Then flags = 0& If IsMissing(DefaultEx) Then DefaultEx = "" If IsMissing(fileName) Then fileName = "" If IsMissing(DialogTitle) Then DialogTitle = "" If IsMissing(hwnd) Then hwnd = 0 If IsMissing(OpenFile) Then OpenFile = True strFileName = Left$(fileName & String(256, 0), 256) FileTitle = String$(256, 0) With OFN .lStructSize = LenB(OFN) .hwndOwner = CLngPtr(Application.hwnd) .strFilter = Filter .nFilterIndex = FilterIndex .strFile = strFileName .nMaxFile = Len(strFileName) .strFileTitle = FileTitle .nMaxFileTitle = Len(FileTitle) .strTitle = DialogTitle .flags = flags .strDefExt = DefaultEx .strInitialDir = InitialDir End With If OpenFile Then fResult = th_apiGetOpenFileName(OFN) Else fResult = th_apiGetSaveFileName(OFN) If fResult Then If Not IsMissing(flags) Then flags = OFN.flags thCommonFileOpenSave = TrimNull(OFN.strFile) Else thCommonFileOpenSave = vbNullString End If End Function Public Function thAddFilterItem(strFilter As String, strDescription As String, Optional varItem As Variant) As String If IsMissing(varItem) Then varItem = "*.*" thAddFilterItem = strFilter & strDescription & vbNullChar & varItem & vbNullChar End Function Private Function TrimNull(ByVal strItem As String) As String Dim intPos As Integer intPos = InStr(strItem, vbNullChar) If intPos > 0 Then TrimNull = Left(strItem, intPos - 1) Else TrimNull = strItem End If End Function |
24.06.2010, 10:19 | #8 |
MOF Meister |
Ersetze ich "LongLong" durch "Long" (entspricht dann wohl in etwa dem Code des TO?)dann funktioniert es auch in Excel 2010 32-bit unter Windows 7 64-bit. Mit diesem "LongLong" hat sich MS mal wieder was ausgedacht...
Ich benutze aber lieber meinen Code. Da kann ich die Dateiendung flexibel angeben (gut für Office 2007/2010-Dateiformate). |