Mit ein paar kleinen Änderungen kann man die Funktionen aus dem Tipp Öffnen/Speichern-Dialog ohne ActiveX Unicode-fähig machen. Hierzu verwendet man lediglich die Widechar Versionen der API Funktionen und passt die OPENFILENAME Struktur ein wenig an. Kopieren Sie folgenden Code in ein Modul: Option Explicit ' Für Unicode müssen die Strings als Pointer übergeben werden, ' daher Long statt String Private Type OPENFILENAME_WCHAR lStructSize As Long hwndOwner As Long hInstance As Long lpstrFilter As Long lpstrCustomFilter As Long nMaxCustFilter As Long nFilterIndex As Long lpstrFile As Long nMaxFile As Long lpstrFileTitle As Long nMaxFileTitle As Long lpstrInitialDir As Long lpstrTitle As Long flags As Long nFileOffset As Integer nFileExtension As Integer lpstrDefExt As Long lCustData As Long lpfnHook As Long lpTemplateName As Long End Type Private Const OFN_READONLY = &H1 Private Const OFN_OVERWRITEPROMPT = &H2 Private Const OFN_HIDEREADONLY = &H4 Private Const OFN_NOCHANGEDIR = &H8 Private Const OFN_SHOWHELP = &H10 Private Const OFN_ENABLEHOOK = &H20 Private Const OFN_ENABLETEMPLATE = &H40 Private Const OFN_ENABLETEMPLATEHANDLE = &H80 Private Const OFN_NOVALIDATE = &H100 Private Const OFN_ALLOWMULTISELECT = &H200 Private Const OFN_EXTENSIONDIFFERENT = &H400 Private Const OFN_PATHMUSTEXIST = &H800 Private Const OFN_FILEMUSTEXIST = &H1000 Private Const OFN_CREATEPROMPT = &H2000 Private Const OFN_SHAREAWARE = &H4000 Private Const OFN_NOREADONLYRETURN = &H8000 Private Const OFN_NOTESTFILECREATE = &H10000 Private Const OFN_NONETWORKBUTTON = &H20000 Private Const OFN_NOLONGNAMES = &H40000 Private Const OFN_EXPLORER = &H80000 Private Const OFN_NODEREFERENCELINKS = &H100000 Private Const OFN_LONGNAMES = &H200000 Private Const OFN_SHAREFALLTHROUGH = 2 Private Const OFN_SHARENOWARN = 1 Private Const OFN_SHAREWARN = 0 Private Declare Function GetSaveFileName Lib "comdlg32.dll" _ Alias "GetSaveFileNameW" ( _ pOpenfilename As OPENFILENAME_WCHAR) As Long Private Declare Function GetOpenFileName Lib "comdlg32.dll" _ Alias "GetOpenFileNameW" ( _ pOpenfilename As OPENFILENAME_WCHAR) As Long ' Öffnen-Dialog Public Function ShowOpenDlg(F As Form, strFilter As String, _ strTitel As String, strInitDir As String) As String Dim lngOpenFileName As OPENFILENAME_WCHAR Dim lngAnt As Long Dim strFile As String With lngOpenFileName .lStructSize = Len(lngOpenFileName) .hwndOwner = F.hWnd .hInstance = App.hInstance strFilter = Replace$(strFilter, "|", vbNullChar) ' Der Filter muss durch 2 NullChars terminiert werden Do Until Right$(strFilter, 2) = vbNullChar & vbNullChar strFilter = strFilter & vbNullChar Loop strFile = String$(512, 0) ' Sollte bei Multiselect vergrößert werden. .lpstrFilter = StrPtr(strFilter) .lpstrFile = StrPtr(strFile) .nMaxFile = Len(strFile) .lpstrInitialDir = StrPtr(strInitDir) .lpstrTitle = StrPtr(strTitel) .flags = OFN_HIDEREADONLY Or OFN_FILEMUSTEXIST ' Or OFN_ALLOWMULTISELECT Or OFN_EXPLORER lngAnt = GetOpenFileName(lngOpenFileName) If lngAnt Then strFile = TrimNull(strFile) ShowOpenDlg = strFile Else ShowOpenDlg = "" End If End With End Function ' Speichern-Dialog Public Function ShowSaveDlg(F As Form, strFilter As String, _ strTitel As String, strInitDir As String) As String Dim lngOpenFileName As OPENFILENAME_WCHAR Dim lngAnt As Long Dim strFile As String With lngOpenFileName .lStructSize = Len(lngOpenFileName) .hwndOwner = F.hWnd .hInstance = App.hInstance strFilter = Replace$(strFilter, "|", vbNullChar) Do Until Right$(strFilter, 2) = vbNullChar & vbNullChar strFilter = strFilter & vbNullChar Loop strFile = String$(512, 0) .lpstrFilter = StrPtr(strFilter) .lpstrFile = StrPtr(strFile) .nMaxFile = Len(strFile) .lpstrInitialDir = StrPtr(strInitDir) .lpstrTitle = StrPtr(strTitel) .flags = OFN_HIDEREADONLY Or OFN_OVERWRITEPROMPT Or _ OFN_CREATEPROMPT lngAnt = GetSaveFileName(lngOpenFileName) If lngAnt Then strFile = TrimNull(strFile) ShowSaveDlg = strFile Else ShowSaveDlg = "" End If End With End Function ' Trim Funktion für vbNullChars Public Function TrimNull(ByVal Text As String) As String Dim lngStart As Long Dim lngEnd As Long lngEnd = Len(Text) For lngStart = 1 To lngEnd If Asc(Mid$(Text, lngStart, 1)) <> 0 Then For lngEnd = lngEnd To lngStart Step -1 If Asc(Mid$(Text, lngEnd, 1)) <> 0 Then TrimNull = Mid$(Text, lngStart, lngEnd - lngStart + 1) Exit Function End If Next lngEnd End If Next lngStart End Function Ein Aufruf von strFile = ShowOpenDlg(Me, "Musik|*.mp3|Videos|*.avi;*.mpg", "Datei öffnen", "C:\") liefert nun korrekte Ergebnisse bei Unicode Dateinamen. Versucht man jetzt allerdings eine Datei mit Unicode Zeichen im Namen mit VB Bordmitteln zu öffnen, schlägt dies leider fehl, da VB offensichtlich mit solchen Dateinamen nicht umgehen kann. Doch hier kann man Abhilfe schaffen, indem man die Unicode Variante der GetShortPathName API verwendet, um den Dateinamen ins alte 8.3 Format umzuwandeln. Dann enthält dieser keine Unicode-Zeichen mehr und die Datei kann mit der Open Anweisung geöffnet werden.ü> Ergänzen Sie das Modul mit folgender Deklaration und Funktion: Private Declare Function GetShortPathName Lib "kernel32" _ Alias "GetShortPathNameW" ( _ ByVal lpszLongPath As Long, _ ByVal lpszShortPath As Long, _ ByVal cchBuffer As Long) As Long Public Function GetShortName(ByVal strLongName As String) As String Dim ShortName As String Dim sLen As Long ShortName = Space$(256) sLen = GetShortPathName(StrPtr(strLongName), _ StrPtr(ShortName), Len(ShortName)) ShortName = Left$(ShortName, sLen) GetShortName = ShortName End Function Eine Datei mit Unicode Namen kann man dann wie folgt öffnen: Open GetShortName(strFile) For (….) as #FN Hinweis: Dieser Tipp wurde bereits 15.037 mal aufgerufen. Voriger Tipp | Zufälliger Tipp | Nächster Tipp
Anzeige
Diesen und auch alle anderen Tipps & Tricks finden Sie auch auf unserer aktuellen vb@rchiv Vol.6 Ein absolutes Muss - Geballtes Wissen aus mehr als 8 Jahren vb@rchiv! - nahezu alle Tipps & Tricks und Workshops mit Beispielprojekten - Symbol-Galerie mit mehr als 3.200 Icons im modernen Look Weitere Infos - 4 Entwickler-Vollversionen (u.a. sevFTP für .NET), Online-Update-Funktion u.v.m. |
TOP! Unser Nr. 1 Neu! sevDataGrid 3.0 Mehrspaltige Listen, mit oder ohne DB-Anbindung. Autom. Sortierung, Editieren von Spalteninhalten oder das interaktive Hinzufügen von Datenzeilen sind ebenso möglich wie das Erstellen eines Web-Reports. Tipp des Monats April 2024 Skyfloy Chart von Microsoft und dazu noch gratis Tutorial für Microsoft Chart Controls für Microsoft .NET Framework 3.5 Access-Tools Vol.1 Über 400 MByte Inhalt Mehr als 250 Access-Beispiele, 25 Add-Ins und ActiveX-Komponenten, 16 VB-Projekt inkl. Source, mehr als 320 Tipps & Tricks für Access und VB |
||||||||||||||||
Microsoft, Windows und Visual Basic sind entweder eingetragene Marken oder Marken der Microsoft Corporation in den USA und/oder anderen Ländern. Weitere auf dieser Homepage aufgeführten Produkt- und Firmennamen können geschützte Marken ihrer jeweiligen Inhaber sein. |