Solved

Importing text files with file selection

Posted on 2000-03-02
10
1,936 Views
Last Modified: 2007-10-18
I need to setup a button that will automate the the importing of a text file into a set database, but I need to permit the user to choose which file to import as new files will be available weekly with different names.  I would like to have some sort of Open/Browse/File selection to make it easy to change folders if needed.  I am very new OLE so I need the answer in simple terms.  I have looked at using Common Dialog control, but get an error message that is not available.  I want a solution that will work at all sites I have deploy this application.
0
Comment
Question by:thereb
  • 4
  • 2
  • 2
  • +2
10 Comments
 
LVL 30

Expert Comment

by:hnasr
Comment Utility
To make the qustion clearer, you need:

1- A button on your form.
2- to click the button allows you to select the text file to import.
3- the process to import the selected file.
4- use the form anywhere you like.
0
 
LVL 3

Expert Comment

by:davereynolds
Comment Utility
Hi thereb,
I'm going to assume that you are using Access 97, which provides no mechanism for you to get to any of the common dialogs for your own application, but does provide an interface to the Office File Open dialog. I'd like to claim that I invented this but I got it from the Access 97 Developer's Handbook by SYBEX.

The following code snippet opens the Open File dialog box so that your user can browse for the file to be imported (put it in the button's Click event):

' Allow user to browse for file
    Dim gfni As adh_accOfficeGetFileNameInfo
    With gfni
        .hwndOwner = Application.hWndAccessApp
        .strAppName = "appname" ' describe the app
        .strDlgTitle = "Find the file to import" ' text that appears in the dialog caption
        .strOpenTitle = "Select" ' text that appears in the Open button
        .strFile = ""
        .strInitialDir = "c:\" ' starting dir for browse
        .strFilter = "All (*.*)"
 ' filter        .lngFilterIndex = 1
        .lngView = adhcGfniViewList
        .lngFlags = adhcGfniNoChangeDir Or adhcGfniInitializeView
    End With
    If adhOfficeGetFileName(gfni, True) <> adhcAccErrSuccess Then ' operator did not choose a file
        MsgBox "Cancelling import", vbOKOnly
        Exit Sub
    End If
    ImportPath = Trim(gfni.strFile)

In order for this code to work you must create a new module, call it basDeclares, and paste the following code (this is pretty long):

Option Compare Database
Option Explicit

' General Errors
Public Const adhcAccErrSuccess = 0
Public Const adhcAccErrUnknown = -1

' File handling
' Sizes for buffers for SplitPath from stdlib.h
Const adhcSP_MAXPATH = 260
Const adhcSP_MAXDRIVE = 3
Const adhcSP_MAXDIR = 256
Const adhcSP_MAXFNAME = 256
Const adhcSP_MAXEXT = 256

' FileExists return values
Public Const adhcFileExistsYes = 1
Public Const adhcFileExistsNo = 0

Declare Function adh_accFileExists Lib "msaccess.exe" Alias "#57" _
 (ByVal strSrc As String) As Integer
Declare Function adh_accFullPath Lib "msaccess.exe" Alias "#58" _
 (ByVal strAbsPath As String, ByVal strFullPath As String, _
 ByVal cchFullPathMax As Integer) As Integer
Declare Sub adh_accSplitPath Lib "msaccess.exe" Alias "#59" _
 (ByVal strPath As String, ByVal strDrive As String, _
 ByVal strDir As String, ByVal strFName As String, ByVal strExt As String)
 
' Common Dialogs
' GetFileName errors
Public Const adhcAccErrGFNCantOpenDialog = -301
Public Const adhcAccErrGFNUserCancelledDialog = -302


' GetFileNameInfo flags
Public Const adhcGfniConfirmReplace = &H1              ' Prompt if overwriting a file?
Public Const adhcGfniNoChangeDir = &H2                ' Disable the read-only option
Public Const adhcGfniAllowReadOnly = &H4                   ' Don't change to the directory the user selected?
Public Const adhcGfniAllowMultiSelect = &H8            ' Allow multiple-selection?
Public Const adhcGfniDirectoryOnly = &H20              ' Open as directory picker?
Public Const adhcGfniInitializeView = &H40             ' Initialize the view to the lView member or use last selected view?

' Views in the Office Find File dialog
Public Const adhcGfniViewDetails = 0                  ' Details
Public Const adhcGfniViewPreview = 1                  ' Preview
Public Const adhcGfniViewProperties = 2               ' Properties
Public Const adhcGfniViewList = 3                     ' List (typical)

Type adh_accOfficeGetFileNameInfo
    hwndOwner As Long
    strAppName As String * 255
    strDlgTitle As String * 255
    strOpenTitle As String * 255
    strFile As String * 4096
    strInitialDir As String * 255
    strFilter As String * 255
    lngFilterIndex As Long
    lngView As Long
    lngFlags As Long
End Type

Declare Function adh_accOfficeGetFileName Lib "msaccess.exe" _
 Alias "#56" (gfni As adh_accOfficeGetFileNameInfo, ByVal fOpen As Integer) As Long
Declare Function adh_accChooseColor Lib "msaccess.exe" _
 Alias "#53" (ByVal hWnd As Long, rgb As Long) As Long

' Registry
' Predefined root keys for the registry.
Public Const adhcHKEY_CLASSES_ROOT = &H80000000
Public Const adhcHKEY_CURRENT_USER = &H80000001
Public Const adhcHKEY_LOCAL_MACHINE = &H80000002
Public Const adhcHKEY_USERS = &H80000003
Public Const adhcHKEY_PERFORMANCE_DATA = &H80000004

' Data types for data in the registry
Public Const adhcREG_NONE = 0
Public Const adhcREG_SZ = 1
Public Const adhcREG_EXPAND_SZ = 2
Public Const adhcREG_BINARY = 3
Public Const adhcREG_DWORD = 4
Public Const adhcREG_DWORD_LITTLE_ENDIAN = 4
Public Const adhcREG_DWORD_BIG_ENDIAN = 5
Public Const adhcREG_LINK = 6
Public Const adhcREG_MULTI_SZ = 7
Public Const adhcREG_RESOURCE_LIST = 8
Public Const adhcREG_FULL_RESOURCE_DESCRIPTOR = 9
Public Const adhcREG_RESOURCE_REQUIREMENTS_LIST = 10

' Registry Errors
Public Const adhcAccErrRegKeyNotFound = -201
Public Const adhcAccErrRegValueNotFound = -202
Public Const adhcAccErrRegCantSetValue = -203
Public Const adhcAccErrRegSubKeyNotFound = -204
Public Const adhcAccErrRegTypeNotSupported = -205
Public Const adhcAccErrRegCantCreateKey = -206

Declare Function adh_accRegGetVal Lib "msaccess.exe" Alias "#70" _
 (ByVal hkeyRoot As Long, ByVal strSubKey As String, _
 ByVal strValName As String, lpData As Any, ByVal lngMaxLen As Long) As Long
Declare Function adh_accRegWriteVal Lib "msaccess.exe" Alias "#71" _
 (ByVal hkeyRoot As Long, ByVal strSubKey As String, ByVal strValName As String, _
 lpData As Any, ByVal lngType As Long) As Long
Declare Function adh_accRegGetKeyInfo Lib "msaccess.exe" Alias "#72" _
 (ByVal hkeyRoot As Long, ByVal strSubKey As String, _
 lngSubKeys As Long, lngValues As Long) As Long
Declare Function adh_accRegGetValName Lib "msaccess.exe" Alias "#73" _
 (ByVal hkeyRoot As Long, ByVal strSubKey As String, ByVal lngValue As Long, _
 ByVal strValName As String, ByVal lngMaxLen As Long, lngType As Long) As Long
Declare Function adh_accRegWriteKey Lib "msaccess.exe" Alias "#74" _
 (ByVal hkeyRoot As Long, ByVal strSubKey As String, _
 ByVal strClass As String) As Long
Declare Function adh_accRegGetKey Lib "msaccess.exe" Alias "#75" _
 (ByVal hkeyRoot As Long, ByVal strSubKey As String, ByVal lngSubKey As Long, _
 ByVal strName As String, ByVal lngMaxLen As Long) As Long

' Font information
Type adhFontInfo
    fRasterFont As Long
    strName As String * 32
End Type

Declare Function adh_accGetFontCount Lib "msaccess.exe" Alias "#61" _
 (ByVal hdc As Long) As Long
Declare Function adh_accGetFontList Lib "msaccess.exe" Alias "#62" _
 (ByVal hdc As Long, fiFonts() As adhFontInfo) As Long
Declare Function adh_accGetSizeCount Lib "msaccess.exe" Alias "#63" _
 (ByVal hdc As Long, ByVal szFont As String) As Long
Declare Function adh_accGetSizeList Lib "msaccess.exe" Alias "#64" _
 (ByVal hdc As Long, ByVal szFont As String, lSizeList() As Long) As Long

' Get twips from font
Declare Function adh_accTwipsFromFont Lib "msaccess.exe" _
 Alias "#67" (ByVal strFontName As String, ByVal lngSize As Long, _
 ByVal lngWeight As Long, ByVal fItalic As Long, ByVal fUnderline As Long, _
 ByVal lngChars As Long, ByVal strCaption As String, ByVal cchUseMaxWidth As Long, _
 lngWidth As Long, lngHeight As Long) As Integer

' Handle objects
Public Const adhcBitObjSystem = &H10000000
Public Const adhcBitObjHidden = &H20000000

' Table flags
Public Const adhcBitTblLocal = &H1000&
Public Const adhcBitTblAttachedISAM = &H2000&
Public Const adhcBitTblAttachedODBC = &H4000&
Public Const adhcBitTblAll = &H7000&

' Query flags are all part of Jet, but this one just makes
' it clear that you want all queries.
Public Const adhcBitQryAll = &H3FF

Type adhDBObj
    intObjType As Integer
    strName As String
    lngFlags As Long
End Type

Declare Function adh_accGetObjNames Lib "msaccess.exe" Alias "#79" _
 (ByVal varWrk As Variant, ByVal varDB As Variant, ByVal intObjType As Integer, _
 ByVal lngFlags As Long, astrObjects() As String, ByVal intStart As Integer, _
 intItemsFilled As Integer) As Long
 
Declare Function adh_accGetDbobjList Lib "msaccess.exe" Alias "#80" _
 (ByVal varWrk As Variant, ByVal varDB As Variant, ByVal intObjType As Integer, _
 ByVal lngFlags As Long, atypObjects() As adhDBObj, ByVal intStart As Integer, _
 intItemsFilled As Integer) As Long

Declare Function adh_accSortStringArray Lib "msaccess.exe" Alias "#81" _
 (astrObjects() As String) As Long

Declare Function adh_accSortDbobjArray Lib "msaccess.exe" Alias "#82" _
 (atypObjects() As adhDBObj, ByVal fNamesOnly As Long) As Long

' Miscellaneous
Declare Function adh_accGetLanguage Lib "msaccess.exe" Alias "#51" () As Long
Declare Function adh_accGetTbDIB Lib "msaccess.exe" Alias "#60" _
 (ByVal lngBmp As Long, ByVal fLarge As Long, bytBuf() As Byte) As Long

' Programming Functions
Declare Function adh_accIsValidIdentifier Lib "msaccess.exe" Alias "#84" _
 (ByVal strIdentCand As String) As Boolean
Declare Function adh_accGlobalProcExists Lib "msaccess.exe" Alias "#37" _
 (ByVal strProcName As String) As Long
' Get the type of a recordsource. 0 for SQL, 1 for table, 2 for query.
Declare Function adh_accTypeOfStrRS Lib "msaccess.exe" Alias "#83" _
 (ByVal strRS As String) As Integer

Public Const adhcAccRSTypeSQL = 0
Public Const adhcAccRSTypeTable = 1
Public Const adhcAccRSTypeQuery = 2

Declare Function adh_apiSendMessage Lib "USER32" Alias "SendMessageA" _
 (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long

' Create an Information Context
Declare Function adh_apiCreateIC Lib "gdi32" Alias "CreateICA" _
 (ByVal lpDriverName As String, ByVal lpDeviceName As String, _
 ByVal lpOutput As String, lpInitData As Any) As Long
' Close an existing Device Context (or information context)
Declare Function adh_apiDeleteDC Lib "gdi32" Alias "DeleteDC" _
 (ByVal hdc As Long) As Long

' Language Return Values
' To save Public space, most of these are commented out.
' If your situation involves checking for more of these, uncomment the
' ones you care about.
'Public Const adhcArabic = 1025                    'Arabic
'Public Const adhcBulgarian = 1026                 'Bulgarian
'Public Const adhcCatalan = 1027                   'Catalan
'Public Const adhcTraditionalChinese = 1028        'Traditional Chinese
'Public Const adhcCzech = 1029                     'Czech
'Public Const adhcDanish = 1030                    'Danish
Public Const adhcGerman = 1031                    'German
'Public Const adhcGreek = 1032                     'Greek
Public Const adhcUSEnglish = 1033                 'U.S. English
'Public Const adhcCastilianSpanish = 1034          'Castilian Spanish
'Public Const adhcFinnish = 1035                   'Finnish
Public Const adhcFrench = 1036                    'French
'Public Const adhcHebrew = 1037                    'Hebrew
'Public Const adhcHungarian = 1038                 'Hungarian
'Public Const adhcIcelandic = 1039                 'Icelandic
Public Const adhcItalian = 1040                   'Italian
'Public Const adhcJapanese = 1041                  'Japanese
'Public Const adhcKorean = 1042                    'Korean
'Public Const adhcDutch = 1043                     'Dutch
'Public Const adhcNorwegianBokmel = 1044           'Norwegian - Bokmel
'Public Const adhcPolish = 1045                    'Polish
'Public Const adhcBrazilianPortuguese = 1046       'Brazilian Portuguese
'Public Const adhcRhaetoRomanic = 1047             'Rhaeto-Romanic
'Public Const adhcRomanian = 1048                  'Romanian
'Public Const adhcRussian = 1049                   'Russian
'Public Const adhcCroatoSerbian = 1050             'Croato-Serbian (Latin)
'Public Const adhcSlovak = 1051                    'Slovak
'Public Const adhcAlbanian = 1052                  'Albanian
'Public Const adhcSwedish = 1053                   'Swedish
'Public Const adhcThai = 1054                      'Thai
'Public Const adhcTurkish = 1055                   'Turkish
'Public Const adhcUrdu = 1056                      'Urdu
'Public Const adhcBahasa = 1057                    'Bahasa
'Public Const adhcSimplifiedChinese = 2052         'Simplified Chinese
'Public Const adhcSwissGerman = 2055               'Swiss German
Public Const adhcUKEnglish = 2057                 'U.K. English
Public Const adhcMexicanSpanish = 2058            'Mexican Spanish
'Public Const adhcBelgianFrench = 2060             'Belgian French
'Public Const adhcSwissItalian = 2064              'Swiss Italian
'Public Const adhcBelgianDutch = 2067              'Belgian Dutch
'Public Const adhcNorwegianNynorsk = 2068          'Norwegian - Nynorsk
'Public Const adhcPortuguese = 2070                'Portuguese
'Public Const adhcSerboCroatian = 2074             'Serbo-Croatian (Cyrillic)
'Public Const adhcCanadianFrench = 3084            'Canadian French
'Public Const adhcSwissFrench = 4108               'Swiss French

Function adhChooseColor(lngColor As Long) As Long
    ' Use the color chooser exposed by Access.
   
    ' From Access 97 Developer's Handbook
    ' by Litwin, Getz, and Gilbert (Sybex)
    ' Copyright 1997.  All rights reserved.
    Debug.Print "Returned: " & adh_accChooseColor(Application.hWndAccessApp, lngColor)
    adhChooseColor = lngColor
End Function

Function adhOfficeGetFileName(gfni As adh_accOfficeGetFileNameInfo, _
 ByVal fOpen As Integer) As Long
 
    ' Use the Office file selector common dialog
    ' exposed by Access.
   
    ' From Access 97 Developer's Handbook
    ' by Litwin, Getz, and Gilbert (Sybex)
    ' Copyright 1997.  All rights reserved.
   
    Dim lng As Long
    With gfni
        .strAppName = RTrim$(.strAppName) & vbNullChar
        .strDlgTitle = RTrim$(.strDlgTitle) & vbNullChar
        .strOpenTitle = RTrim$(.strOpenTitle) & vbNullChar
        .strFile = RTrim$(.strFile) & vbNullChar
        .strInitialDir = RTrim$(.strInitialDir) & vbNullChar
        .strFilter = RTrim$(.strFilter) & vbNullChar
        SysCmd acSysCmdClearHelpTopic
        lng = adh_accOfficeGetFileName(gfni, fOpen)
        .strAppName = RTrim$(adhTrimNull(.strAppName))
        .strDlgTitle = RTrim$(adhTrimNull(.strDlgTitle))
        .strOpenTitle = RTrim$(adhTrimNull(.strOpenTitle))
        .strFile = RTrim$(adhTrimNull(.strFile))
        .strInitialDir = RTrim$(adhTrimNull(.strInitialDir))
        .strFilter = RTrim$(adhTrimNull(.strFilter))
    End With
    adhOfficeGetFileName = lng
End Function

Function adhTrimNull(strVal As String) As String
    ' Trim the end of a string, stopping at the first
    ' null character.
   
    ' From Access 97 Developer's Handbook
    ' by Litwin, Getz, and Gilbert (Sybex)
    ' Copyright 1997.  All rights reserved.
   
    Dim intPos As Integer
    intPos = InStr(strVal, vbNullChar)
    If intPos > 0 Then
        adhTrimNull = Left$(strVal, intPos - 1)
    Else
        adhTrimNull = strVal
    End If
End Function

Function adhHandleAccErrors(intErr As Integer) As Boolean
       
    ' A generic error handler for Access function errors.
   
    ' From Access 97 Developer's Handbook
    ' by Litwin, Getz, and Gilbert (Sybex)
    ' Copyright 1997.  All rights reserved.
   
    ' In:
    '    intErr:  the error number
    ' Out:
    '    Return value: True if this function handled the error,
    '     False if it couldn't.
   
    Dim strMsg As String
    Dim fOK As Boolean
   
    fOK = True
    Select Case intErr
        Case adhcAccErrUnknown
            strMsg = "Unknown error"

        ' Registry Errors
        Case adhcAccErrRegKeyNotFound
            strMsg = "Specified registry key not found"
        Case adhcAccErrRegValueNotFound
            strMsg = "Specified registry value not found"
        Case adhcAccErrRegCantSetValue
            strMsg = "Can't set registry value"
        Case adhcAccErrRegSubKeyNotFound
            strMsg = "Specified subkey not found"
        Case adhcAccErrRegTypeNotSupported
            strMsg = "Specified data type not supported"
        Case adhcAccErrRegCantCreateKey
            strMsg = "Can't create specified registry key"

        ' GetFileName errors
        Case adhcAccErrGFNCantOpenDialog
            strMsg = "Can't open common dialog"
        Case adhcAccErrGFNUserCancelledDialog
            strMsg = "User cancelled dialog"
        Case Else
            fOK = False
    End Select
    If fOK Then
        MsgBox strMsg, vbExclamation, "Error in Acc7032.DLL"
    End If
    adhHandleAccErrors = fOK
End Function

Sub adhSplitPath(pstrPath As String, pstrDrive As String, _
 pstrDir As String, pstrFName As String, pstrExt As String)

    ' A wrapper function for the adh_accSplitPath()
    ' function in MSACCESS.EXE.
    '
    ' From Access 97 Developer's Handbook
    ' by Litwin, Getz, and Gilbert (Sybex)
    ' Copyright 1997.  All rights reserved.
   
    ' In:
    '     pstrPath: the path to split up
    '
    ' Out:
    '     pstrDrive: the drive
    '     pstrDir:   the directory
    '     pstrFName: the file name
    '     pstrExt:   the extension
    '
    Dim strDrive As String * adhcSP_MAXDRIVE
    Dim strDir As String * adhcSP_MAXDIR
    Dim strFName As String * adhcSP_MAXFNAME
    Dim strExt As String * adhcSP_MAXEXT

    adh_accSplitPath pstrPath, strDrive, strDir, strFName, strExt

    pstrDrive = adhTrimNull(strDrive)
    pstrDir = adhTrimNull(strDir)
    pstrFName = adhTrimNull(strFName)
    pstrExt = adhTrimNull(strExt)
End Sub

Function adhFullPath(strFileName As String) As String

    ' A wrapper function for the adh_accFullPath() function.
    '
    ' From Access 97 Developer's Handbook
    ' by Litwin, Getz, and Gilbert (Sybex)
    ' Copyright 1997.  All rights reserved.
   
    ' In:
    '     strFileName: relative filename to convert to full path name
    '
    ' Out:
    '     Return Value: full path name for strFileName
    ' For example:
    ' Given that the current directory is "E:\adh\CH19",
    '
    '    adhFullPath("..\AHT\CH06\CH06TXT.DOC")
    '
    ' would return
    '
    '    E:\AHT\CH06\CH06TXT.DOC
    '
    ' The function does not check for the existence of that file,
    ' only converts a relative path into a fully qualified path.
   
    Dim strBuffer As String * adhcSP_MAXPATH
    Dim intRetval As Integer

    intRetval = adh_accFullPath(strFileName, strBuffer, adhcSP_MAXPATH)
    adhFullPath = Left(strBuffer, intRetval)
End Function

Function adhCvtQryTypeToBit(ByVal lngItem As Long) As Long
    ' Convert query constants (dbQSelect, etc.) to the flag
    ' format that the dbObj functions require.
   
    ' From Access 97 Developer's Handbook
    ' by Litwin, Getz, and Gilbert (Sybex)
    ' Copyright 1997.  All rights reserved.
   
    ' In:
    '   lngItem: a query constant (dbQSelect, dbQDDL, etc.)
    ' Out:
    '   Return value: a bitmapped value corresponding to the constant
   
    adhCvtQryTypeToBit = 2 ^ (lngItem / 16 + 1)
End Function

Function adhGetAppInfo(lngFlags As Long) As Long
    ' Set the output based on whether or not
    ' you've selected to see hidden/system objects.
   
    ' From Access 97 Developer's Handbook
    ' by Litwin, Getz, and Gilbert (Sybex)
    ' Copyright 1997.  All rights reserved.
   
    ' In:
    '    lngFlags: value of the flag before calling this function.
    '      New values are OR'd with it.
    ' Out:
    '    Return value: the new value of the flags
   
    If Application.GetOption("Show Hidden Objects") Then
        lngFlags = lngFlags Or adhcBitObjHidden
    Else
        lngFlags = lngFlags And Not adhcBitObjHidden
    End If
    If Application.GetOption("Show System Objects") Then
        lngFlags = lngFlags Or adhcBitObjSystem
    Else
        lngFlags = lngFlags And Not adhcBitObjSystem
    End If
    adhGetAppInfo = lngFlags
End Function

Function adhCBFProcExists(Frm As Form, strProcName As String) As Integer

    ' Determine if a specific proc already exists behind specified form.
    ' Not sure this is really necessary, but it worked in Access 2 and 95 and it
    ' should work in 97. At this moment, it does not work.
    '
    ' From Access 97 Developer's Handbook
    ' by Litwin, Getz, and Gilbert (Sybex)
    ' Copyright 1997.  All rights reserved.
   
    ' In:
    '     frm: Form reference
    '     strProcName: Name to check
    ' Out:
    '     Return Value: True if the proc exists, False otherwise
    '
    ' Example:
    ' If adhCBFProcExists(Forms!frmButtonPix, "cboApply_AfterUpdate") Then
    '

Const adhcWM_PROCEXISTS = 1434

  adhCBFProcExists = adh_apiSendMessage((Frm.hWnd), adhcWM_PROCEXISTS, _
   0, ByVal strProcName) <> 0
End Function

0
 
LVL 3

Expert Comment

by:davereynolds
Comment Utility
A formatting error occurred. In the code snippet where you see:
 
        .strFilter = "All (*.*)"
 ' filter        .lngFilterIndex = 1

it should be:
    .strFilter = "All (*.*)" ' filter
    .lngFilterIndex = 1

The code snippet returns the full path to file indicated by the operator in the "ImportPath" variable. You can then use this in a Docmd.TransferText command to peform the actual import.

I'll be watching to see if anyone comes up with anything simpler, but this does work.

HTH
0
 
LVL 54

Expert Comment

by:nico5038
Comment Utility
Did you try to register the Common Dialog control?
It should be available!

Take Tools/ActiveX controls...
And Register the "comdlg32.ocx":
Normally: c:\Windows\system\comdlg32.ocx

(Your path may differ)
0
 
LVL 1

Accepted Solution

by:
EvanL earned 100 total points
Comment Utility
I've got a way I do this all the time that works like a charm.  This may be similar to Dave's comment.  No ActiveX controls or additional references are needed to make this work.  Its very reusable, as I copy the following module over and over and use it in multiple databases.  This also works for MS Access 97 and 2000.

First, copy the following and put it in a stand-alone module.

Option Compare Database
Option Explicit

' Declarations for Windows Common Dialogs procedures
Private Type CLTAPI_OPENFILE
    strFilter As String                                   ' Filter string
    intFilterIndex As Long                                ' Initial Filter to display.
    strInitialDir As String                               ' Initial directory for the dialog to open in.
    strInitialFile As String                              ' Initial file name to populate the dialog with.
    strDialogTitle As String                              ' Dialog title
    strDefaultExtension As String                         ' Default extension to append to file if user didn't specify one.
    lngFlags As Long                                      ' Flags (see constant list) to be used.
    strFullPathReturned As String                         ' Full path of file picked.
    strFileNameReturned As String                         ' File name of file picked.
    intFileOffset As Integer                              ' Offset in full path (strFullPathReturned) where the file name (strFileNameReturned) begins.
    intFileExtension As Integer                           ' Offset in full path (strFullPathReturned) where the file extension begins.
End Type

Const ALLFILES = "All Files"

Private Type CLTAPI_WINOPENFILENAME
    lStructSize As Long
    hWndOwner As Long
    hInstance As Long
    lpstrFilter As String
    lpstrCustomFilter As String
    nMaxCustrFilter As Long
    nFilterIndex As Long
    lpstrFile As String
    nMaxFile As Long
    lpstrFileTitle As String
    nMaxFileTitle As Long
    lpstrInitialDir As String
    lpstrTitle As String
    Flags As Long
    nFileOffset As Integer
    nFileExtension As Integer
    lpstrDefExt As String
    lCustrData As Long
    lpfnHook As Long
    lpTemplateName As String
End Type

Const OFN_ALLOWMULTISELECT = &H200
Const OFN_CREATEPROMPT = &H2000
Const OFN_EXPLORER = &H80000
Const OFN_FILEMUSTEXIST = &H1000
Const OFN_HIDEREADONLY = &H4
Const OFN_NOCHANGEDIR = &H8
Const OFN_NODEREFERENCELINKS = &H100000
Const OFN_NONETWORKBUTTON = &H20000
Const OFN_NOREADONLYRETURN = &H8000
Const OFN_NOVALIDATE = &H100
Const OFN_OVERWRITEPROMPT = &H2
Const OFN_PATHMUSTEXIST = &H800
Const OFN_READONLY = &H1
Const OFN_SHOWHELP = &H10

Declare Function CLTAPI_GetOpenFileName Lib "comdlg32.dll" Alias "GetOpenFileNameA" _
        (pOpenfilename As CLTAPI_WINOPENFILENAME) _
        As Boolean

Declare Function CLTAPI_GetSaveFileName Lib "comdlg32.dll" Alias "GetSaveFileNameA" _
        (pOpenfilename As CLTAPI_WINOPENFILENAME) _
        As Boolean

Declare Sub CLTAPI_ChooseColor Lib "msaccess.exe" Alias "#53" _
        (ByVal hwnd As Long, rgb As Long)

Function GetOpenFile_CLT(strInitialDir As String, strTitle As String) As String
' Comments  : Simple file open routine. For additional options, use GetFileOpenEX_CLT()
' Parameters: strInitialDir - path for the initial directory, or blank for the current directory
'             strTitle - title for the dialog
' Returns   : string path, name and extension of the file selected
'
    Dim fOK As Boolean
    Dim typWinOpen As CLTAPI_WINOPENFILENAME
    Dim typOpenFile As CLTAPI_OPENFILE
    Dim strFilter As String

    On Error GoTo PROC_ERR

    ' Set defaults for the structure
    strFilter = CreateFilterString_CLT("All Files (*.*)", "*.*", "Database Files (*.MDB)", "*.MDB")

    If strInitialDir <> "" Then
        typOpenFile.strInitialDir = strInitialDir
    Else
        typOpenFile.strInitialDir = CurDir()
    End If

    If strTitle <> "" Then
        typOpenFile.strDialogTitle = strTitle
    End If

    typOpenFile.strFilter = strFilter
    typOpenFile.lngFlags = OFN_HIDEREADONLY Or OFN_SHOWHELP

    ' Convert the CLT structure to a Win structure
    ConvertCLT2Win typOpenFile, typWinOpen

    ' Call the Common dialog
    fOK = CLTAPI_GetOpenFileName(typWinOpen)

    ' Convert the Win structure back to a CLT structure
    ConvertWin2CLT typWinOpen, typOpenFile

    GetOpenFile_CLT = typOpenFile.strFullPathReturned

PROC_EXIT:
    Exit Function

PROC_ERR:
    GetOpenFile_CLT = ""
    Resume PROC_EXIT

End Function

Sub ConvertCLT2Win(CLT_Struct As CLTAPI_OPENFILE, Win_Struct As CLTAPI_WINOPENFILENAME)
' Comments  : Converts the passed CLTAPI structure to a Windows structure
' Parameters: CLT_Struct - record of type CLTAPI_OPENFILE
'             Win_Struct - record of type CLTAPI_WINOPENFILENAME
' Returns   : Nothing
'
    Dim strFile As String * 512

    On Error GoTo PROC_ERR

    Win_Struct.hWndOwner = Application.hWndAccessApp
    Win_Struct.hInstance = 0

    If CLT_Struct.strFilter = "" Then
        Win_Struct.lpstrFilter = ALLFILES & Chr$(0) & "*.*" & Chr$(0)
    Else
        Win_Struct.lpstrFilter = CLT_Struct.strFilter
    End If
    Win_Struct.nFilterIndex = CLT_Struct.intFilterIndex

    Win_Struct.lpstrFile = String(512, 0)
    Win_Struct.nMaxFile = 511

    Win_Struct.lpstrFileTitle = String$(512, 0)
    Win_Struct.nMaxFileTitle = 511

    Win_Struct.lpstrTitle = CLT_Struct.strDialogTitle
    Win_Struct.lpstrInitialDir = CLT_Struct.strInitialDir
    Win_Struct.lpstrDefExt = CLT_Struct.strDefaultExtension

    Win_Struct.Flags = CLT_Struct.lngFlags

    Win_Struct.lStructSize = Len(Win_Struct)

PROC_EXIT:
    Exit Sub

PROC_ERR:
    Resume PROC_EXIT

End Sub

Sub ConvertWin2CLT(Win_Struct As CLTAPI_WINOPENFILENAME, CLT_Struct As CLTAPI_OPENFILE)
' Comments  : Converts the passed CLTAPI structure to a Windows structure
' Parameters: Win_Struct - record of type CLTAPI_WINOPENFILENAME
'             CLT_Struct - record of type CLTAPI_OPENFILE
' Returns   : Nothing
'
    On Error GoTo PROC_ERR

    CLT_Struct.strFullPathReturned = Left(Win_Struct.lpstrFile, InStr(Win_Struct.lpstrFile, vbNullChar) - 1)
    CLT_Struct.strFileNameReturned = RemoveNulls_CLT(Win_Struct.lpstrFileTitle)
    CLT_Struct.intFileOffset = Win_Struct.nFileOffset
    CLT_Struct.intFileExtension = Win_Struct.nFileExtension

PROC_EXIT:
    Exit Sub

PROC_ERR:
    Resume PROC_EXIT

End Sub

Function CreateFilterString_CLT(ParamArray varFilt() As Variant) As String
' Comments  : Builds a Windows formatted filter string for "file type"
' Parameters: varFilter - parameter array in the format:
'                          Text, Filter, Text, Filter ...
'                         Such as:
'                          "All Files (*.*)", "*.*", "Text Files (*.TXT)", "*.TXT"
' Returns   : windows formatted filter string
'
    Dim strFilter As String
    Dim intCounter As Integer
    Dim intParamCount As Integer

    On Error GoTo PROC_ERR

    ' Get the count of paramaters passed to the function
    intParamCount = UBound(varFilt)

    If (intParamCount <> -1) Then

        ' Count through each parameter
        For intCounter = 0 To intParamCount
            strFilter = strFilter & varFilt(intCounter) & Chr$(0)
        Next

        ' Check for an even number of parameters
        If (intParamCount Mod 2) = 0 Then
            strFilter = strFilter & "*.*" & Chr$(0)
        End If

    End If

    CreateFilterString_CLT = strFilter

PROC_EXIT:
    Exit Function

PROC_ERR:
    CreateFilterString_CLT = ""
    Resume PROC_EXIT

End Function

Function RemoveNulls_CLT(StrIn As String) As String
' Comments  : Removes terminator from a string
' Parameters: strIn - string to modify
' Return    : modified string
'
    Dim intChr As Integer

    intChr = InStr(StrIn, Chr$(0))

    If intChr > 0 Then
        RemoveNulls_CLT = Left$(StrIn, intChr - 1)
    Else
        RemoveNulls_CLT = StrIn
    End If

End Function

--------------------------------------------------------------------

Then, make a form with a textbox called txtTextPath and a command button called cmdBrowse.

Add this code to the form's module:

Private Sub cmdBrowse_Click()

    'Declare the string variable to hold the text report file path
    Dim strFilePath As String
   
    'Declare the string string variable to hold the file name
    Dim strFile As String
   
    'Call the GetOpenFile function to open the common dialog box
    strFile = GetOpenFile_CLT(strFilePath, "Select a Text File Report To Open")
   
    'Set the text box equal to the contents of the variable
    Me!txtTextPath = strFile

End Sub

-----------------------------------------

When you click the Browse button, the user can find the file, and click Open to put its path in the textbox.  Then the import procedure looks at that textbox's value property for the path and filename.

If you want an MDB sample, I'd be glad to email one to you.  Sometimes code can get messed up pasting in this window.

Good luck!



0
How your wiki can always stay up-to-date

Quip doubles as a “living” wiki and a project management tool that evolves with your organization. As you finish projects in Quip, the work remains, easily accessible to all team members, new and old.
- Increase transparency
- Onboard new hires faster
- Access from mobile/offline

 
LVL 1

Expert Comment

by:EvanL
Comment Utility
Oh yeah, I forgot to mention:

I use some code that lets the user set the default file path, so that way when they click the Browse button, they don't have to navigate through 20 folders to get to the location they need to be at.

The default file path is stored in the user's registry, so its unique for each person which is nice.  The code is simple.  Let me know if you want it and I'll post it here.
0
 

Author Comment

by:thereb
Comment Utility
This worked great, thanks a lot for the help, sorry I didn't get back before now to award the points.  I also tried the first answer by davereyolds but that did not seem to work, maybe due to cut and pasting errors.
 
0
 
LVL 1

Expert Comment

by:EvanL
Comment Utility
Not a problem.. If you need similar code to select and save a file, lemme know.
0
 

Author Comment

by:thereb
Comment Utility
How did you know what my next question was going to be?  I now need to export out a table that was generated and want to define the table name by a standard set of letters followed by the date so each time it is unique for emailing to a stat center.  The format would look something like, genosnj_20000316 (site name_year,month,day).  Is there an easy way to code this date into the do.cmd for exporting the file, so I can specify the folder where it would be located and it would automatically use the current date when the file was generated.
0
 
LVL 1

Expert Comment

by:EvanL
Comment Utility
Been there, done that..

My issue, was importing an ascii file from the user's selection, processing it, checking the data for errors, fixing the data errors, and then letting the user select a location to save it.

You could create that date by making your own date format:
Perhaps "yyyymmdd"?  I'd have to check this further.

Or you could create a local table with four fields:
SiteName as Text
Year as Text
Month as Text
Day as Text

and concatenate the strings to make the file name.

If you want the code that lets you select a file to save, post a new question with my name on it and I'll work up the code.  It works very similar to the code you used to select a file for import.  Glad to help..
0

Featured Post

Threat Intelligence Starter Resources

Integrating threat intelligence can be challenging, and not all companies are ready. These resources can help you build awareness and prepare for defense.

Join & Write a Comment

This article is a continuation or rather an extension from Cascading Combos (http://www.experts-exchange.com/A_5949.html) and builds on examples developed in detail there. It should be understandable alone, but I recommend reading the previous artic…
In the article entitled Working with Objects – Part 1 (http://www.experts-exchange.com/Microsoft/Development/MS_Access/A_4942-Working-with-Objects-Part-1.html), you learned the basics of working with objects, properties, methods, and events. In Work…
As developers, we are not limited to the functions provided by the VBA language. In addition, we can call the functions that are part of the Windows operating system. These functions are part of the Windows API (Application Programming Interface). U…
Familiarize people with the process of utilizing SQL Server views from within Microsoft Access. Microsoft Access is a very powerful client/server development tool. One of the SQL Server objects that you can interact with from within Microsoft Access…

762 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

12 Experts available now in Live!

Get 1:1 Help Now