|
title: Put the knife down and take a green herb, dude. |
descrip: One feller's views on the state of everyday computer science & its application (and now, OTHER STUFF) who isn't rich enough to shell out for www.myfreakinfirst-andlast-name.com Self-Pimpin': Member of an email list? You need The Digest Handler!! |
|||||||||||||||||||
| FOR ENTERTAINMENT PURPOSES ONLY!!! Back-up your data and always wear white. | ||||||||||||||||||||
| ||||||||||||||||||||
| Wednesday, July 30, 2003 | ||||||||||||||||||||
|
Basically I just wanted to stop having to hunt for this on CD to type it up from some slightly application-specific code and just come here from now on. Or, worse still, not paste the code in at all and start from scratch. QUELLE HORROR!!! Just paste this code into a module called "mdlComDlg" or something similar. Poof. (Updated 1/28/2004) Option Explicit 'File Selection routine 'Copyright (C) 2003-4 R. Bailey ' 'This library is free software; you can redistribute it and/or 'modify it under the terms of the GNU Lesser General Public 'License as published by the Free Software Foundation; either 'version 2.1 of the License, or (at your option) any later version. ' 'This library is distributed in the hope that it will be useful, 'but WITHOUT ANY WARRANTY; without even the implied warranty of 'MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU 'Lesser General Public License for more details. ' 'You should have received a copy of the GNU Lesser General Public 'License along with this library; if not, write to the Free Software 'Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA Public fso As FileSystemObject ' You must have a CommonDialog on some widget somewhere to pass in. You apparently ' can't create one at runtime from what I've googled. ' ' Will return "" if no file is selected/user cancels the select/an error occurs ' before a file is selected. ' ' Pass in a collection of extensions to search for with code similar to the following: ' ' Dim colExts As Collection ' Set colExts = New Collection ' ' With colExts ' .Add ".txt" ' .Add ".html" ' .Add ".htm" ' End With ' ' Me.RichTextBox1.Text = mdlComDlg.selectFile(Me.CommonDialog1, "C:\", colExts) Public Function selectFile(cdlgTemp As CommonDialog, _ Optional strInitDir As String = "", _ Optional colFileExtensions As Collection, _ Optional bCreateFileNotOpen As Boolean = False, _ Optional strRetValIfCancel As String = "") As String On Error GoTo errHand ' mainly just going to be capturing ' for the cancel button in the common dialog control Dim strReturn As String Dim strFilter As String Dim strDot As String Dim strPipe As String Dim strTemp As String Dim varTemp As Variant Dim lngFlags As Long Dim isFileSelected As Boolean ' b/c of the way cancel errors ' are handled, we might branch out of the logic before everything's saved. ' If the user got far enough to select a file, ' we'll save it out in the error handler on cancel. ' This var will tell us if they got that far. strReturn = "" ' no file yet isFileSelected = False ' no file yet strFilter = "" strPipe = "" strDot = "" Set fso = New FileSystemObject With cdlgTemp If fso.FolderExists(strInitDir) Then .InitDir = strInitDir Else .InitDir = App.Path End If .FileName = "" ' set up filters with the extensions (strings) in colFileExtensions. If Not colFileExtensions Is Nothing Then For Each varTemp In colFileExtensions strTemp = CStr(varTemp) If InStr(strTemp, ".") = 1 Then strDot = "" Else strDot = "." End If strFilter = strFilter & _ strPipe & _ strTemp & " Files (*" & strDot & strTemp & ")" & _ "|*" & strDot & strTemp strPipe = "|" ' separator after the first extension type. Next .Filter = strFilter End If .FilterIndex = 0 lngFlags = mscomdlg.cdlOFNPathMustExist + _ mscomdlg.cdlOFNHideReadOnly If Not bCreateFileNotOpen Then lngFlags = lngFlags + mscomdlg.cdlOFNFileMustExist Else lngFlags = lngFlags + mscomdlg.cdlOFNOverwritePrompt End If .Flags = lngFlags .CancelError = True ' cancelling causes an error If bCreateFileNotOpen Then .ShowSave Else .ShowOpen End If strReturn = .FileName ' If they cancelled, ' we'll have "errored out" (cancelerror = true) isFileSelected = True ' If they didn't, ' remember that we've gotten this far. ' insert any code that needs to happen after a file is selected. End With selectFile = strReturn Exit Function errHand: If Not Err.Number = 32755 Then ' 32755 means that cancel ' was selected, and we'll ignore that one ' by just dropping out of the sub entirely MsgBox Err.Number & " :: " & Err.Description If Not isFileSelected Then strReturn = "" End If Else ' else we've got a cancel error strReturn = strRetValIfCancel End If selectFile = strReturn End Function posted by ruffin at 7/30/2003 10:08:00 AM |
||||||||||||||||||||
| 0 comments | ||||||||||||||||||||
|
|
||||||||||||||||||||
|
|
|