Directory View in MS Access97

[boyd.ireland]

I have a lot of txt files to import into a database all the files are fixed length and same format i.e. two fields barcode and qty. I need an easy way to import these into access by clicking on a button opening a window that will allow the user to browse to the directory where these text files are stored then when the user clicks on a file it is imported into the database I have sussed the import routine and designed some code that will not allow the same file to be imported twice however I require something that opens the "Directory Browse" window or what ever it is called I think i need to call an ocx but I don't know if any one out there can help I would be eternally greatful

[brju]

The code that you are looking for calls the common dialog box.
This code was written for Access 2000 to check table links (Note: I have excluded the functions that check and relink), so you might have to alter as appropriate.

Option Explicit
Option Compare Database

' Declaration of API Functions
Declare Function GetOpenFileName Lib "comdlg32.dll" Alias _
"GetOpenFileNameA" (pOpenfilename As OPENFILENAME) As Boolean
Declare Function GetSaveFileName Lib "comdlg32.dll" Alias _
"GetSaveFileNameA" (pOpenfilename As OPENFILENAME) As Boolean

' Type Declaration for the GetOpenFileName and GetSaveFileName.
Type MSA_OPENFILENAME
strFilter As String 'Used for the File Type Dropdown
' Created with MSA_CreateFilterString()
' Default = All Files, *.*
lngFilterIndex As Long 'Initial filter to display
' Default = 1
strInitialDir As String 'Initial directory to open in.
' Default = Current working directory.
strInitialFile As String 'Default file name
' Default = ""
strDialogTitle As String
strDefaultExtension As String
' Default = System Values (Open File, Save File).
lngFlags As Long 'Flags (see constant list) to be used.
' Default = no flags.
strFullPathReturned As String ' Full path of file picked.
' If a nonexistent file is entered,
' only the text in the "File Name" box is returned.
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 (strFullPathReturned) where the extension begins.
End Type

Const ALLFILES = "All Files"

Type OPENFILENAME
lStructSize As Long
hwndOwner As Long
hInstance As Long
lpstrFilter As String
lpstrCustomFilter As Long
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 Long
End Type

' Constants for GetOpenFileName and GetSaveFileName
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

' Constants for Application Specific Information
Const strDATABASE As String = "Your File"
Const strFILE As String = "File Name"
Const strPATH As String = "C:\Windows\"
Const strTable As String = "YourTable"

Function FindDatabase(strSearchPath) As String
' Displays the Open dialog box to locate the database.
' It returns the full path.
Dim msaof As MSA_OPENFILENAME
' Set options for the dialog box.
msaof.strDialogTitle = "Where Is " & strDATABASE & "?"
msaof.strInitialDir = strSearchPath
msaof.strFilter = MSA_CreateFilterString("Databases", "*.mdb")
' Call the Open dialog routine.
MSA_GetOpenFileName msaof
' Return the path and file name.
FindDatabase = Trim(msaof.strFullPathReturned)
End Function

Function MSA_CreateFilterString(ParamArray varFilt() As Variant) _
As String
' Creates a filter string from the passed in arguments.
' Returns "" if no arguments are passed in.
' Expects an even number of arguments (filter name, extension),
' but if an odd number is passed in, it appends "*.*".
Dim strFilter As String
Dim intRet As Integer
Dim intNum As Integer

intNum = UBound(varFilt)
If (intNum <> -1) Then
For intRet = 0 To intNum
strFilter = strFilter & varFilt(intRet) & vbNullChar
Next
If intNum Mod 2 = 0 Then
strFilter = strFilter & "*.*" & vbNullChar
End If
strFilter = strFilter & vbNullChar
Else
strFilter = ""
End If
MSA_CreateFilterString = strFilter
End Function

Function MSA_ConvertFilterString(strFilterIn As String) As String
' Creates a filter string from a bar ("|") separated string.
' The string should pairs of filter|extension strings,
' i.e. "Access Databases|*.mdb|All Files|*.*"
' If no extensions exists for the last filter pair, *.* is added.
' This code will ignore any empty strings, i.e. "||" pairs.
' Returns "" if the strings passed in is empty.
Dim strFilter As String
Dim intNum As Integer, intPos As Integer, intLastPos As Integer
strFilter = ""
intNum = 0
intPos = 1
intLastPos = 1

' Add strings as long as we find bars.
' Ignore any empty strings (not allowed).
Do
intPos = InStr(intLastPos, strFilterIn, "|")
If (intPos > intLastPos) Then
strFilter = strFilter & Mid(strFilterIn, intLastPos, _
intPos - intLastPos) & vbNullChar
intNum = intNum + 1
intLastPos = intPos + 1
ElseIf (intPos = intLastPos) Then
intLastPos = intPos + 1
End If
Loop Until (intPos = 0)

' Get last string if it exists
' (assuming strFilterIn was not bar terminated).
intPos = Len(strFilterIn)
If (intPos >= intLastPos) Then
strFilter = strFilter & Mid(strFilterIn, intLastPos, _
intPos - intLastPos + 1) & vbNullChar
intNum = intNum + 1
End If

' Add *.* if there's no extension for the last string.
If intNum Mod 2 = 1 Then
strFilter = strFilter & "*.*" & vbNullChar
End If

' Add terminating NULL if we have any filter.
If strFilter <> "" Then
strFilter = strFilter & vbNullChar
End If

MSA_ConvertFilterString = strFilter
End Function

Private Function MSA_GetSaveFileName(msaof As MSA_OPENFILENAME) _
As Integer
' Opens the file save dialog.
Dim of As OPENFILENAME
Dim intRet As Integer
MSAOF_to_OF msaof, of
of.Flags = of.Flags Or OFN_HIDEREADONLY
intRet = GetSaveFileName(of)
If intRet Then
OF_to_MSAOF of, msaof
End If
MSA_GetSaveFileName = intRet
End Function

Function MSA_SimpleGetSaveFileName() As String
' Opens the file save dialog with default values.
Dim msaof As MSA_OPENFILENAME
Dim intRet As Integer
Dim strRet As String
intRet = MSA_GetSaveFileName(msaof)
If intRet Then
strRet = msaof.strFullPathReturned
End If
MSA_SimpleGetSaveFileName = strRet
End Function

Private Function MSA_GetOpenFileName(msaof As MSA_OPENFILENAME) _
As Integer
' Opens the Open dialog.
Dim of As OPENFILENAME
Dim intRet As Integer
MSAOF_to_OF msaof, of
intRet = GetOpenFileName(of)
If intRet Then
OF_to_MSAOF of, msaof
End If
MSA_GetOpenFileName = intRet
End Function

Function MSA_SimpleGetOpenFileName() As String
' Opens the Open dialog with default values.
Dim msaof As MSA_OPENFILENAME
Dim intRet As Integer
Dim strRet As String
intRet = MSA_GetOpenFileName(msaof)
If intRet Then
strRet = msaof.strFullPathReturned
End If
MSA_SimpleGetOpenFileName = strRet
End Function

Private Sub OF_to_MSAOF(of As OPENFILENAME, msaof As MSA_OPENFILENAME)
' Converts from the Win32 String to an Access String.
msaof.strFullPathReturned = Left(of.lpstrFile, InStr(of.lpstrFile, vbNullChar) - 1)
msaof.strFileNameReturned = of.lpstrFileTitle
msaof.intFileOffset = of.nFileOffset
msaof.intFileExtension = of.nFileExtension
End Sub

[brju]

cont...

(Code to long for only one post)

Private Sub MSAOF_to_OF(msaof As MSA_OPENFILENAME, of As OPENFILENAME)
' This sub converts from the Access String to an Win32 String.
Dim strFILE As String * 512
' Initialize some parts of the structure.
of.hwndOwner = Application.hWndAccessApp
of.hInstance = 0
of.lpstrCustomFilter = 0
of.nMaxCustrFilter = 0
of.lpfnHook = 0
of.lpTemplateName = 0
of.lCustrData = 0
If msaof.strFilter = "" Then
of.lpstrFilter = MSA_CreateFilterString(ALLFILES)
Else
of.lpstrFilter = msaof.strFilter
End If
of.nFilterIndex = msaof.lngFilterIndex
of.lpstrFile = msaof.strInitialFile _
& String(512 - Len(msaof.strInitialFile), 0)
of.nMaxFile = 511
of.lpstrFileTitle = String(512, 0)
of.nMaxFileTitle = 511
of.lpstrTitle = msaof.strDialogTitle
of.lpstrInitialDir = msaof.strInitialDir
of.lpstrDefExt = msaof.strDefaultExtension
of.Flags = msaof.lngFlags
of.lStructSize = Len(of)
End Sub