Set file path to a variable

benkingery

Registered User.
Local time
Today, 11:24
Joined
Jul 15, 2008
Messages
153
I have a series of files that I need to import on a regular basis. All files will be stored in the same folder and will be .TXT (Pipe delimited files). I am using Docmd.transferText acImportDelim function. I have created and correctly input the import specifications, indicated the table name, and was hoping to use a variable for "FileName". I am looking for some help on how to store the proper filename string to this variable for the code so I can import each file.

Note that each file must be imported separately as I need to run some tasks on the data in each file before I import the next file. here is what I have so far:

Dim FileName As String

DoCmd.TransferText acImportDelim, "CSSalesTransactions", "ORDERS_CSN_OrderBuffer", FileName

Any suggestions on how to continue?
 
Store the FileNames in a table then do a dlookup to retrieve them - You could store all the required variables in the same table if you wanted too - However I would suggest storing the full path in case you move the db to another pc etc
 
Sorry, I think I made it a little unclear. This is a process I'll be doing repeatedly each day. On any given day I will have X amount of files to be imported. I need some way to select the file for importing. Then I'll move on to the next file, etc, etc.
 
Sorry, I think I made it a little unclear. This is a process I'll be doing repeatedly each day. On any given day I will have X amount of files to be imported. I need some way to select the file for importing. Then I'll move on to the next file, etc, etc.

So do you need a dialog box or do you want to programatically read a folder?
 
Dialog box. I'm looking into CommonDialog now. First time using it. Any help?
 
Yip you are on the right path
ComDialog6 I think it is - Will open one of my apps and post simple code
 
This should get you started - to copy past just drop a CommonDialog control on the form - name it CommonDialog3 and add the below to a click event of a button


Code:
 Dim strFilePath As String
    Me.CommonDialog3.Filter = "Excel Files (*.xls) | *.xls"
    Me.CommonDialog3.InitDir = "C:\"
    Me.CommonDialog3.ShowOpen
        If CommonDialog3.FileName = "" Then
            Exit Sub                    ''User Cancelled
        Else
            strFilePath = CommonDialog3.FileName
        End If
        Debug.Print strFilePath
 
This should get you started - to copy past just drop a CommonDialog control on the form -
Actually that is bad advice. A common control dialog is not available to anyone who does not have Visual Studio of some sort installed, except that it would need to be installed to their machine specifically if they do not have a copy of Visual Studio (or one of the apps, like VB6, VB.NET,etc.).

There is a built in file dialog which you can use, but I prefer using this API (just modify things to get the appropriate files - the example on the website shows for Access files, not Excel files).
 
  • Like
Reactions: dcb
I think this helps me out. One question. What if I'm doing this from the user switchboard? I'm not actually doing this from a form. Can I still just code this within a Public function on my module and call that function from the button on the switchboard? Shouldn't be a problem, right?

I'm just wondering how that changes some of the syntax.
 
Actually that is bad advice. A common control dialog is not available to anyone who does not have Visual Studio of some sort installed, except that it would need to be installed to their machine specifically if they do not have a copy of Visual Studio (or one of the apps, like VB6, VB.NET,etc.).

There is a built in file dialog which you can use, but I prefer using this API (just modify things to get the appropriate files - the example on the website shows for Access files, not Excel files).

OK - This i never knew - always thought it was part of Access
I have never had a issue distributing in the past - does access wrap it up?
Thanks BOB
 
OK - This i never knew - always thought it was part of Access
I have never had a issue distributing in the past - does access wrap it up?
It might if you are using the Packaging and Deployment Wizard to build an install package.

But if you set a reference to Microsoft Office X.0 Objects (where X is 11 for 2003, 12 for 2007, etc) you can use it like this (from the Help file):

Access VBA Help File said:
FileDialog Property
See AlsoApplies ToExampleSpecificsReturns a FileDialog object which represents a single instance of a file dialog box.

expression.FileDialog(dialogType)
expression Required. An expression that returns one of the objects in the Applies To list.

dialogType Required MsoFileDialogType. The type of file dialog box.

MsoFileDialogType can be one of these MsoFileDialogType constants.
msoFileDialogFilePicker
msoFileDialogFolderPicker
msoFileDialogOpen
msoFileDialogSaveAs

Example
This example displays the Save As dialog box.
Code:
Dim dlgSaveAs As FileDialog

Set dlgSaveAs = Application.FileDialog( _
    FileDialogType:=msoFileDialogSaveAs)

dlgSaveAs.Show
This example displays the Open dialog box and allows a user to select multiple files to open.
Code:
Dim dlgOpen As FileDialog

Set dlgOpen = Application.FileDialog( _
    FileDialogType:=msoFileDialogOpen)

With dlgOpen
    .AllowMultiSelect = True
    .Show
End With
 
I have always set the reference....
Never packaged

Prob just been lucky actually (you never know what other custom software could have already installed this - it is a very common feature on most)

Anyway we are leaving benkingery behind here;)
Have you come right?
The link Bob gave is great - and you can call it from code:D
 
I'm obviously new enough to code & syntax that I can't exactly tell what I'm doing here. I put in the sample code into my VB editor and I get the message "Compile Error: Sub or Function not defined". when I click "ok" the part for ahtAddFilterItem becomes highlighted. Not quite sure what to do

here.
Code:
Public Function Test()
    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 (*.*)", "*.*")

    ' Uncomment this line to try the example
    ' allowing multiple file names:
    ' lngFlags = ahtOFN_ALLOWMULTISELECT Or ahtOFN_EXPLORER

    Dim result As Variant

    result = ahtCommonFileOpenSave(InitialDir:="C:\", _
        Filter:=strFilter, FilterIndex:=3, Flags:=lngFlags, _
        DialogTitle:="Hello! Open Me!")

    If lngFlags And ahtOFN_ALLOWMULTISELECT Then
        If IsArray(result) Then
            Dim i As Integer
            For i = 0 To UBound(result)
                MsgBox result(i)
            Next i
        Else
            MsgBox result
        End If
    Else
        MsgBox result
    End If

    ' Since you passed in a variable for lngFlags,
    ' the function places the output flags value in the variable.
    Debug.Print Hex(lngFlags)


End Function
 
You want to create a new module - Put everything in there (from start code to end code) and play around in there first - with the test function
 
So, did you copy all of that code in the blue area to a new STANDARD MODULE (not form or report module) and then name the module something like basFiles and then save it?

Then, you just call the dialog by simply using something like the text above the blue part:
Code:
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)

strSaveFileName would be what you would then use for the action on the file.
 
So if I can get the examples to work, I'm usually pretty good about massaging them to get what I need. I have this exact code in a new Module (not on form or in report).

As I try to run it, I'm getting "Compile error: Expected variable or procedure, not module."

Code:
Public Function Testing()

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)

End Function

Maybe I don't have something added in my object library?
 
Oops. my bad. I had named the module same as function. I have now named module "Test" and function "Testing"

I'm now getting the error:

"Compile Error: Sub or Function not defined"

When the error pops up the portion of code that is highlighted is "ahtAddFilterItem"
 
Oops. my bad. I had named the module same as function. I have now named module "Test" and function "Testing"

I'm now getting the error:

"Compile Error: Sub or Function not defined"

When the error pops up the portion of code that is highlighted is "ahtAddFilterItem"

You did paste the ENTIRE code from the green spot into that module, correct? Because part of it includes:
Code:
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

Also, make sure you didn't add any PRIVATE to any part of those.
 
Wow, so I need to put ALL of this code into the module?


Code:
' 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 originally courtesy of:
' Microsoft Access 95 How-To
' Ken Getz and Paul Litwin
' Waite Group Press, 1996
' Revised to support multiple files:
' 28 December 2007

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 (*.*)", "*.*")

    ' Uncomment this line to try the example
    ' allowing multiple file names:
    ' lngFlags = ahtOFN_ALLOWMULTISELECT Or ahtOFN_EXPLORER

    Dim result As Variant

    result = ahtCommonFileOpenSave(InitialDir:="C:\", _
        Filter:=strFilter, FilterIndex:=3, Flags:=lngFlags, _
        DialogTitle:="Hello! Open Me!")

    If lngFlags And ahtOFN_ALLOWMULTISELECT Then
        If IsArray(result) Then
            Dim i As Integer
            For i = 0 To UBound(result)
                MsgBox result(i)
            Next i
        Else
            MsgBox result
        End If
    Else
        MsgBox result
    End If

    ' 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
        If Flags And ahtOFN_ALLOWMULTISELECT Then
            ' Return the full array.
            Dim items As Variant
            Dim value As String
            value = OFN.strFile
            ' Get rid of empty items:
            Dim i As Integer
            For i = Len(value) To 1 Step -1
              If Mid$(value, i, 1) <> Chr$(0) Then
                Exit For
              End If
            Next i
            value = Mid(value, 1, i)

            ' Break the list up at null characters:
            items = Split(value, Chr(0))

            ' Loop through the items in the "array",
            ' and build full file names:
            Dim numItems As Integer
            Dim result() As String

            numItems = UBound(items) + 1
            If numItems > 1 Then
                ReDim result(0 To numItems - 2)
                For i = 1 To numItems - 1
                    result(i - 1) = FixPath(items(0)) & items(i)
                Next i
                ahtCommonFileOpenSave = result
            Else
                ' If you only select a single item,
                ' Windows just places it in item 0.
                ahtCommonFileOpenSave = items(0)
            End If
        Else
            ahtCommonFileOpenSave = TrimNull(OFN.strFile)
        End If
    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

Private Function FixPath(ByVal path As String) As String
    If Right$(path, 1) <> "\" Then
        FixPath = path & "\"
    Else
        FixPath = path
    End If
End Function
 

Users who are viewing this thread

Back
Top Bottom