Link to home
Start Free TrialLog in
Avatar of AlexBrown61
AlexBrown61

asked on

Select a file API?

I have a sub that imports a complex delimited text file. I want to be able to have the user select the file in a "windows explorer" like fasion. I have found a the code below that uses the find a file API but don't know how to pass the file to my sub.

Option Compare Database
Option Explicit

'*********************** BEGIN COPY ************************
'the open filename api
Declare Function GetOpenFileName Lib "comdlg32.dll" Alias "GetOpenFileNameA" (pOpenfilename As gFILE) As Long

' the gFILE type needed by the open filename api
Type gFILE
lStructSize As Long
hwndOwner As Long
hInstance As Long
lpstrFilter As String
lpstrCustomFilter As String
nMaxCustFilter 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
lCustData As Long
lpfnHook As Long
lpTemplateName As String

End Type


Public Function FileToOpen(Optional StartLookIn) As String
'Purpose: Calls the open file api to let the user select the file to open
'returns: string value which contains the path to the file selected. "" = no file seleted

Dim ofn As gFILE
Dim path As String
Dim filename As String
Dim a As String

StartOver:
ofn.lStructSize = Len(ofn)
ofn.lpstrFilter = "Text Files (*.csv)" _
+ Chr$(0) + "*.csv" + Chr$(0) + "All Files (*.*)" + Chr$(0) + "*.*" + Chr$(0)
ofn.lpstrFile = Space$(254)
ofn.nMaxFile = 255
ofn.lpstrFileTitle = Space$(254)
ofn.nMaxFileTitle = 255

If Not IsMissing(StartLookIn) Then
ofn.lpstrInitialDir = StartLookIn
Else
ofn.lpstrInitialDir = "c:\some default directory"
End If

ofn.lpstrTitle = "Please find and select the document to open"
ofn.flags = 0

a = GetOpenFileName(ofn)
If (a) Then
path = Trim(ofn.lpstrFile)
filename = Trim(ofn.lpstrFileTitle)
If Dir(path) <> "" Then FileToOpen = -1
FileToOpen = Trim(ofn.lpstrFile)
Else
FileToOpen = ""
path = ""
filename = ""
End If

FileToOpen = path

End Function

'*********************** END COPY *************************

What is the code to select a file using "windows style" explorer and pass it to my sub "Private Sub ImportText()" for text transfer?
Avatar of flavo
flavo
Flag of Australia image

Alex,

This is the one is use

'API: Call the standard Windows File Open/Save dialog box
'Paste the following code in a new module
'***************** Code Start **************
'This code was originally written by Ken Getz.
'It is not to be altered or distributed, except as part of an application.
'You are free to use it in any application,
'provided the copyright notice is left unchanged.
'
' Code courtesy of:
' Microsoft Access 95 How-To
' Ken Getz and Paul Litwin
' Waite Group Press, 1996

Type tagOPENFILENAME
lStructSize As Long
hwndOwner As Long
hInstance As Long
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 Long
lpTemplateName As String
End Type
Declare Function aht_apiGetOpenFileName Lib "comdlg32.dll" _
Alias "GetOpenFileNameA" (OFN As tagOPENFILENAME) As Boolean
Declare Function aht_apiGetSaveFileName Lib "comdlg32.dll" _
Alias "GetSaveFileNameA" (OFN As tagOPENFILENAME) As Boolean
Declare Function CommDlgExtendedError Lib "comdlg32.dll" () As Long
Global Const ahtOFN_READONLY = &H1
Global Const ahtOFN_OVERWRITEPROMPT = &H2
Global Const ahtOFN_HIDEREADONLY = &H4
Global Const ahtOFN_NOCHANGEDIR = &H8
Global Const ahtOFN_SHOWHELP = &H10
' You won't use these.
'Global Const ahtOFN_ENABLEHOOK = &H20
'Global Const ahtOFN_ENABLETEMPLATE = &H40
'Global Const ahtOFN_ENABLETEMPLATEHANDLE = &H80
Global Const ahtOFN_NOVALIDATE = &H100
Global Const ahtOFN_ALLOWMULTISELECT = &H200
Global Const ahtOFN_EXTENSIONDIFFERENT = &H400
Global Const ahtOFN_PATHMUSTEXIST = &H800
Global Const ahtOFN_FILEMUSTEXIST = &H1000
Global Const ahtOFN_CREATEPROMPT = &H2000
Global Const ahtOFN_SHAREAWARE = &H4000
Global Const ahtOFN_NOREADONLYRETURN = &H8000
Global Const ahtOFN_NOTESTFILECREATE = &H10000
Global Const ahtOFN_NONETWORKBUTTON = &H20000
Global Const ahtOFN_NOLONGNAMES = &H40000
' New for Windows 95
Global Const ahtOFN_EXPLORER = &H80000
Global Const ahtOFN_NODEREFERENCELINKS = &H100000
Global Const ahtOFN_LONGNAMES = &H200000
Function TestIt()
Dim strFilter As String
Dim lngFlags As Long
strFilter = ahtAddFilterItem(strFilter, "Access Files (*.mda, *.mdb)", _
"*.MDA;*.MDB")
strFilter = ahtAddFilterItem(strFilter, "dBASE Files (*.dbf)", "*.DBF")
strFilter = ahtAddFilterItem(strFilter, "Text Files (*.txt)", "*.TXT")
strFilter = ahtAddFilterItem(strFilter, "All Files (*.*)", "*.*")
MsgBox "You selected: " & ahtCommonFileOpenSave(InitialDir:="C:\Program Files\ParamicsV4\", _
Filter:=strFilter, FilterIndex:=3, Flags:=lngFlags, _
DialogTitle:="Hello! Open Me!")
' Since you passed in a variable for lngFlags,
' the function places the output flags value in the variable.
Debug.Print Hex(lngFlags)
End Function

Function GetOpenFile(Optional varDirectory As Variant, _
Optional varTitleForDialog As Variant) As Variant
' Here's an example that gets an Access database name.
Dim strFilter As String
Dim lngFlags As Long
Dim varFileName As Variant
' Specify that the chosen file must already exist,
' don't change directories when you're done
' Also, don't bother displaying
' the read-only box. It'll only confuse people.
lngFlags = ahtOFN_FILEMUSTEXIST Or _
ahtOFN_HIDEREADONLY Or ahtOFN_NOCHANGEDIR
If IsMissing(varDirectory) Then
varDirectory = ""
End If
If IsMissing(varTitleForDialog) Then
varTitleForDialog = ""
End If

' Define the filter string and allocate space in the "c"
' string Duplicate this line with changes as necessary for
' more file templates.
strFilter = ahtAddFilterItem(strFilter, _
"Access (*.mdb)", "*.MDB;*.MDA")
' Now actually call to get the file name.
varFileName = ahtCommonFileOpenSave( _
OpenFile:=True, _
InitialDir:=varDirectory, _
Filter:=strFilter, _
Flags:=lngFlags, _
DialogTitle:=varTitleForDialog)
If Not IsNull(varFileName) Then
varFileName = TrimNull(varFileName)
End If
GetOpenFile = varFileName
End Function
Function ahtCommonFileOpenSave( _
Optional ByRef Flags As Variant, _
Optional ByVal InitialDir As Variant, _
Optional ByVal Filter As Variant, _
Optional ByVal FilterIndex As Variant, _
Optional ByVal DefaultExt As Variant, _
Optional ByVal FileName As Variant, _
Optional ByVal DialogTitle As Variant, _
Optional ByVal hwnd As Variant, _
Optional ByVal OpenFile As Variant) As Variant
' This is the entry point you'll use to call the common
' file open/save dialog. The parameters are listed
' below, and all are optional.
'
' In:
' Flags: one or more of the ahtOFN_* constants, OR'd together.
' InitialDir: the directory in which to first look
' Filter: a set of file filters, set up by calling
' AddFilterItem. See examples.
' FilterIndex: 1-based integer indicating which filter
' set to use, by default (1 if unspecified)
' DefaultExt: Extension to use if the user doesn't enter one.
' Only useful on file saves.
' FileName: Default value for the file name text box.
' DialogTitle: Title for the dialog.
' hWnd: parent window handle
' OpenFile: Boolean(True=Open File/False=Save As)
' Out:
' Return Value: Either Null or the selected filename
Dim OFN As tagOPENFILENAME
Dim strFileName As String
Dim strFileTitle As String
Dim fResult As Boolean
' Give the dialog a caption title.
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(DefaultExt) Then DefaultExt = ""
If IsMissing(FileName) Then FileName = ""
If IsMissing(DialogTitle) Then DialogTitle = ""
If IsMissing(hwnd) Then hwnd = Application.hWndAccessApp
If IsMissing(OpenFile) Then OpenFile = True
' Allocate string space for the returned strings.
strFileName = Left(FileName & String(256, 0), 256)
strFileTitle = String(256, 0)
' Set up the data structure before you call the function
With OFN
.lStructSize = Len(OFN)
.hwndOwner = hwnd
.strFilter = Filter
.nFilterIndex = FilterIndex
.strFile = strFileName
.nMaxFile = Len(strFileName)
.strFileTitle = strFileTitle
.nMaxFileTitle = Len(strFileTitle)
.strTitle = DialogTitle
.Flags = Flags
.strDefExt = DefaultExt
.strInitialDir = InitialDir
' Didn't think most people would want to deal with
' these options.
.hInstance = 0
.strCustomFilter = ""
.nMaxCustFilter = 0
.lpfnHook = 0
'New for NT 4.0
.strCustomFilter = String(255, 0)
.nMaxCustFilter = 255
End With
' This will pass the desired data structure to the
' Windows API, which will in turn it uses to display
' the Open/Save As Dialog.
If OpenFile Then
fResult = aht_apiGetOpenFileName(OFN)
Else
fResult = aht_apiGetSaveFileName(OFN)
End If

' The function call filled in the strFileTitle member
' of the structure. You'll have to write special code
' to retrieve that if you're interested.
If fResult Then
' You might care to check the Flags member of the
' structure to get information about the chosen file.
' In this example, if you bothered to pass in a
' value for Flags, we'll fill it in with the outgoing
' Flags value.
If Not IsMissing(Flags) Then Flags = OFN.Flags
ahtCommonFileOpenSave = TrimNull(OFN.strFile)
Else
ahtCommonFileOpenSave = vbNullString
End If
End Function
Function ahtAddFilterItem(strFilter As String, _
strDescription As String, Optional varItem As Variant) As String
' Tack a new chunk onto the file filter.
' That is, take the old value, stick onto it the description,
' (like "Databases"), a null character, the skeleton
' (like "*.mdb;*.mda") and a final null character.

If IsMissing(varItem) Then varItem = "*.*"
ahtAddFilterItem = 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
'************** Code End *****************

Sub Just_More_Notes()

End Sub
'To call the actual dialog from your code, see the enclosed function TestIt()
'within the module or use the following example as a guideline and
'Dim strFilter As String
'Dim strInputFileName As String
'
strFilter = ahtAddFilterItem(strFilter, "Excel Files (*.XLS)", "*.XLS")
strInputFileName = ahtCommonFileOpenSave(Filter:=strFilter, OpenFile:=True, _
DialogTitle:="Please select an input file...", _
Flags:=ahtOFN_HIDEREADONLY)

'Note that in order to call the Save As dialog box,you can use the
'same wrapper function by just setting the OpenFile option as False. For example,

'Ask for SaveFileName
strFilter = ahtAddFilterItem(myStrFilter, "Excel Files (*.xls)", "*.xls")
strSaveFileName = ahtCommonFileOpenSave(OpenFile:=False, Filter:=strFilter, _
Flags:=ahtOFN_OVERWRITEPROMPT Or ahtOFN_READONLY)
End Sub
Function OpenTextFile(Optional varDirectory As Variant) As Variant
Dim strFilter As String, lngFlags As Long, varFileName As Variant
Dim MyFile As Variant

lngFlags = ahtOFN_FILEMUSTEXIST Or _
ahtOFN_HIDEREADONLY Or ahtOFN_NOCHANGEDIR
If IsMissing(varDirectory) Then
varDirectory = ""
End If
' you can choose to add a number of file extensions which will appear in the drop down Files of Type box
strFilter = ahtAddFilterItem(strFilter, "Text files (*.txt)", "*.txt")
strFilter = ahtAddFilterItem(strFilter, "Any files (*.*)", "*.*")
varFileName = ahtCommonFileOpenSave( _
OpenFile:=True, _
InitialDir:=varDirectory, _
Filter:=strFilter, _
Flags:=lngFlags, _
DialogTitle:="Open a text file ...") ' < This is the title to your dialog box
MyFile = varFileName

'---------------------------------------------
Call OpenFile(MyFile) '************************************
'---------------------------------------------


If Not IsNull(varFileName) Then
varFileName = TrimNull(varFileName)
End If
OpenTextFile = varFileName
End Function

Sub OpenFile(MyFile As Variant)


       DoCmd.TransferText acImportFixed, "SatFlow", "Data", MyFile, 1
         
           
       
End Sub

' ************************** end code ********************8

The you can call it by using the Function OpenTextFile("Your Starting Drive / Directory")

This will import using the Sub OpenFile(MyFile As Variant) {the last one}

you will need to change        DoCmd.TransferText acImportFixed, "SatFlow", "Data", MyFile, 1  to you specified import type and table..


Flav's

Alex,
This will do it delim with commas

Replace

DoCmd.TransferText acImportFixed, "SatFlow", "Data", MyFile, 1
With
           DoCmd.TransferText acExportDelim, , "tblMyTable", MyFile, -1 'if you want the field names (top row has field names)
           or
           DoCmd.TransferText acExportDelim, , "tblMyTable", MyFile, 0 'if they dont

in the last sub (OpenFile(MyFile As Variant))

Flav's

Wops,

acImportDelim not acExportDelim

Flav's
ASKER CERTIFIED SOLUTION
Avatar of flavo
flavo
Flag of Australia image

Link to home
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
Start Free Trial
Avatar of Scott McDaniel (EE MVE )
From your event:

ImportText(GetOpenFile)
Sorry ... that should be:

ImportText(FileToOpen)

And, if you want to specify a starting directory:

ImportText(FileToOpen("C:\YourDirectory\YourFolder"))
Hi

I use this, has served me well for some time:

Alan :)


  Dim sFolder As String
  Dim fso As Scripting.FileSystemObject
  Dim aFiles As Variant
   
  sFolder = CurrentProject.Path

  Set fso = New Scripting.FileSystemObject

  aFiles = apiBrowseFiles("Add Attachment Files", sFolder)



===================
win32_BrowseFiles (Module)
===================
Option Compare Database
Option Explicit

Private Type tOpenFilename
  lStructSize As Long                  ' length, in bytes, of the structure
  hWndOwner As Long                    ' window owner (or Null ie. 0 ?)
  hInstance As Long                    ' for customised dialog templates
  lpstrFilter As String                ' Pointer to a buffer containing pairs of null-terminated filter strings. The last string in the buffer must be terminated by two NULL characters
  lpstrCustomFilter As String          ' for preserving user-defined filter patterns at run-time
  nMaxCustFilter As Long               ' size of lpstrCustomFilter
  nFilterIndex As Long                 ' index of the currently selected filter in the File Types control
  lpstrFile As String                  ' initial File Name. returns full path of selected file
  nMaxFile As Long                     ' size of lpstrFile (should be at least 256 characters)
  lpstrFileTitle As String             ' returns filename and extension (without path information) of the selected file
  nMaxFileTitle As Long                ' size of lpstrFileTitle
  lpstrInitialDir As String            ' initial file directory
  lpstrTitle As String                 ' size of lpstrInitialDir
  Flags As Long
  nFileOffset As Integer               ' zero-based offset to file name in lpstrFile
  nFileExtension As Integer            ' zero-based offset to extension in lpstrFile
  lpstrDefExt As String                ' GetOpenFileName and GetSaveFileName append this extension to the filename if the user fails to type an extension
  lCustData As Long                    ' for hook procedure
  lpfnHook As Long                     ' for hook procedure
  lpTemplateName As String             ' for customised dialog templates
End Type


Private Const OFN_ALLOWMULTISELECT = &H200    ' List box allows multiple selections. If you also set the OFN_EXPLORER flag, the dialog box uses the Explorer-style user interface; otherwise, it uses the old-style user interface
                                              ' If the user selects more than one file, the lpstrFile buffer returns the path to the current directory followed by the filenames of the selected files. The nFileOffset member is the offset, in bytes or characters, to the first filename, and the nFileExtension member is not used.
                                              ' For Explorer-style dialog boxes, the directory and filename strings are NULL separated, with an extra NULL character after the last filename. This format enables the Explorer-style dialogs to return long filenames that include spaces.
                                              ' For old-style dialog boxes, the directory and filename strings are separated by spaces and the function uses short filenames for filenames with spaces
Private Const OFN_ENABLEHOOK = &H20           ' for WM_NOTIFY messages sent to the hook procedure
Private Const OFN_ENABLETEMPLATE = &H40       ' for customised dialog templates
Private Const OFN_ENABLETEMPLATEHANDLE = &H80 ' for customised dialog templates
Private Const OFN_EXPLORER = &H80000          ' This flag is necessary only if you provide a hook procedure or custom template, or set the OFN_ALLOWMULTISELECT flag
Private Const OFN_EXTENSIONDIFFERENT = &H400  ' for GetSaveFileName - user typed a filename extension that differs from the extension specified by lpstrDefExt
Private Const OFN_FILEMUSTEXIST = &H1000      ' If this flag is specified, the OFN_PATHMUSTEXIST flag is also used
Private Const OFN_HIDEREADONLY = &H4          ' Hides the Read Only check box
Private Const OFN_LONGNAMES = &H200000        ' default?
Private Const OFN_NOCHANGEDIR = &H8           ' Restores the current directory to its original value if the user changed the directory while searching for files
Private Const OFN_NODEREFERENCELINKS = &H100000  ' Return the path and filename of the selected shortcut (.LNK) file
Private Const OFN_NOLONGNAMES = &H40000       ' Explorer-style dialog boxes ignore this flag and always display long filenames
Private Const OFN_NONETWORKBUTTON = &H20000   ' Hides and disables the Network button
Private Const OFN_NOREADONLYRETURN = &H8000   ' returned file does not have the Read Only check box checked and is not in a write-protected directory.
Private Const OFN_NOTESTFILECREATE = &H10000  ' This flag should be specified if the application saves the file on a create-nonmodify network share
Private Const OFN_NOVALIDATE = &H100          ' allow invalid characters in the returned filename - for hook procedure?
Private Const OFN_OVERWRITEPROMPT = &H2       ' Save As dialog box to generate a message box if the selected file already exists
Private Const OFN_PATHMUSTEXIST = &H800       ' User can type only valid paths and filenames
Private Const OFN_READONLY = &H1              ' State of the Read Only check box
Private Const OFN_SHAREAWARE = &H4000         ' OpenFile network sharing violation error is ignored else notifies hook procedure
Private Const OFN_SHAREFALLTHROUGH = 2
Private Const OFN_SHARENOWARN = 1
Private Const OFN_SHAREWARN = 0
Private Const OFN_SHOWHELP = &H10


Private Declare Function GetOpenFileName Lib "comdlg32.dll" Alias "GetOpenFileNameA" (pOpenfilename As tOpenFilename) As Long

' GetOpenFileNamePreview ?


Public Function apiBrowseFiles( _
  Optional ByVal Title As String = "Open", _
  Optional ByVal InitialDir As String = "", _
  Optional ByVal InitialFile As String = "", _
  Optional ByVal Filter As String = "", _
  Optional ByVal FilterIndex As Integer = 1 _
  ) As Variant
 
  ' browse for muliple files and return array of files
 
  ' return values
  ' - cancel           - returns an Empty
  ' - one file         - Array("file name")
  ' - multiple files   - Array("file-name","file-name",...)
 
  Dim OpenFile As tOpenFilename
  Dim lFlags As Long
  Dim lReturn As Long
  Dim nNullPos As Integer
  Dim sFolder As String
  Dim sFiles As String
  Dim sFile As String
  '  Dim fso As Scripting.FileSystemObject
  '  Dim f As Scripting.File
  Dim aFiles() As Variant
  Dim n As Integer
 
  apiBrowseFiles = Empty
 
  If Filter = "" Then
    Filter = "All Files (*.*)" & vbNullChar & "*.*" & vbNullChar & vbNullChar
  End If
 
  If InitialDir = "" Then
    InitialDir = CurrentProject.Path    '& "\"
    '    Do While Right(InitialDir, 1) <> "\"
    '      InitialDir = Left(InitialDir, Len(InitialDir) - 1)
    '    Loop
  End If
 
  lFlags = OFN_ALLOWMULTISELECT _
  Or OFN_HIDEREADONLY _
  Or OFN_PATHMUSTEXIST _
  Or OFN_FILEMUSTEXIST _
  Or OFN_EXPLORER
 
  'If Flags And OFN_ALLOWMULTISELECT Then
  '  Flags = Flags Or OFN_EXPLORER
  'End If
 
  With OpenFile
    .lStructSize = Len(OpenFile)
    .hWndOwner = Application.hWndAccessApp
    .lpstrFilter = Filter
    .nFilterIndex = FilterIndex
    .lpstrFile = InitialFile & String(8000, 0)
    .nMaxFile = Len(.lpstrFile) - 1
    .lpstrFileTitle = String(256, 0)
    .nMaxFileTitle = Len(.lpstrFileTitle) - 1
    .lpstrInitialDir = InitialDir
    .lpstrTitle = Title
    .Flags = lFlags
  End With
 
  lReturn = GetOpenFileName(OpenFile)
  If lReturn <> 0 Then
   
    ' There are multiple files if the first NullChar is before the first file name
    sFiles = OpenFile.lpstrFile
    nNullPos = InStr(sFiles, vbNullChar)
   
    If nNullPos > OpenFile.nFileOffset Then
     
      ' one file
      sFiles = Left(sFiles, nNullPos - 1)
      ReDim aFiles(1 To 1)
      aFiles(1) = sFiles
      apiBrowseFiles = aFiles
   
    Else
     
      ' multiple files
      sFolder = Left(sFiles, nNullPos - 1)
      sFiles = Mid(sFiles, nNullPos + 1)
      nNullPos = InStr(sFiles, vbNullChar)
     
      ' Set fso = New Scripting.FileSystemObject
     
      n = 0
      Do While nNullPos > 1
        sFile = sFolder & "\" & Left(sFiles, nNullPos - 1)
        sFiles = Mid(sFiles, nNullPos + 1)
          ' Set f = fso.GetFile(sFile)
          ' If (f.Attributes And (Hidden Or System Or Alias)) = 0 _
          ' And f.Type <> "Shortcut" Then
          '  n = n + 1
          '  ReDim Preserve aFiles(1 To n)
          '  aFiles(n) = f.Path
          ' End If
        n = n + 1
        ReDim Preserve aFiles(1 To n)
        aFiles(n) = sFile
        nNullPos = InStr(sFiles, vbNullChar)
      Loop
     
      If n > 0 Then
        ' apiBrowseFiles = aFiles
        ' GetOpenFileName returns file names in reverse order
        ReDim aReverse(1 To n) As Variant
        Dim i As Integer
        For i = 1 To n
          aReverse(n - i + 1) = aFiles(i)
        Next i
        apiBrowseFiles = aReverse
      End If
   
    End If
 
  End If
 
' problem with GetOpenFileName
' unable to delete folder of selected files until access app is quit
' - Sharing violation, the file may be in use.
End Function
========================