Importing files

[geko]

Hi all just thought I'd share some code with you, in the hope that someone might find it useful. Will post each snippet seperately.

The first one copies files to be imported to a different folder (as the files I am importing are on a server, by copying them locally the import process should be quicker).

There is a table tcfgConfig that specifies the file locations and a module to retrieve the info from it.

Much of the code here I have found and adapted to my needs on the forum, so many thanks to contributors.

Anyway hope someone finds it useful, comments for improvement welcome

Public Sub sFileToImportLocation(strFDir As String, strFType As String, bSFldrs As Boolean)

'==========
'
'   Name:
'   sFileToImportLocation
'
'   Purpose:
'   To copy the file(s) to be imported, to the import location.
'
'   Parameters In:
'   strFDir         The directory to look for files to copy over.
'   strFType        The type of files to copy over.
'   bSFldrs         Whether to look in subfolders or not.
'
'==========

Dim dbFTimp As Database                ' Database object.
Dim rstFTimp As Recordset              ' Recordset object.
Dim objFS As Object                    ' FileSearch object.
Dim iFndCnt As Integer                 ' Integer for the number of files found.
Dim iFCnt As Integer                   ' Integer for the current file number found.
Dim strFTimp As String                 ' The name of the file to import, including the path.
Dim strFileName As String              ' The name of the file to import, minus the path.
    
    ' Open the import status form.
    DoCmd.OpenForm ("frmImportStatus")

    ' Add a comment to the import status form so that the user knows something is happening.
    Forms!frmImportStatus.txtImportStatus.Value = Time() & " Processing started"
    Forms!frmImportStatus.htxtCPrk.SetFocus

    ' Create the database and recordset objects.
    Set dbFTimp = CurrentDb()
    Set rstFTimp = dbFTimp.OpenRecordset("tmpFilesToImport", dbOpenDynaset)

    ' Create the FileSearch object.
    Set objFS = Application.FileSearch

    With objFS

        ' Look for the files of type strFType, in strFDir.
        .LookIn = strFDir
        .FileName = "*" & strFType
        .SearchSubFolders = bSFldrs

        ' Add a comment to the import status form so that the user knows something is happening.
        Forms!frmImportStatus.txtImportStatus.Value = Forms!frmImportStatus.txtImportStatus.Value & Chr(13) + Chr(10) & _
                                                      Time() & " Searching for files of type *" & strFType
        Forms!frmImportStatus.htxtCPrk.SetFocus

        ' Run the file search.
        ' If there are files of the type strFType in strFDir then, check if they have been imported, if not import them.
        If .Execute > 0 Then

            ' Get the number of files found.
            iFndCnt = .FoundFiles.Count

            ' Add a comment to the import status form so that the user knows something is happening.
            Forms!frmImportStatus.txtImportStatus.Value = Forms!frmImportStatus.txtImportStatus.Value & Chr(13) + Chr(10) & _
                                                          Time() & " Found " & iFndCnt & " files of type *" & strFType

            ' Add the name of the file to import to tblFilesToImport, if not already imported.
            For iFCnt = 1 To iFndCnt

            ' Add a comment to the import status form so that the user knows something is happening.
            Forms!frmImportStatus.txtImportStatus.Value = Forms!frmImportStatus.txtImportStatus.Value & Chr(13) + Chr(10) & _
                                                          Time() & " Processing file " & iFCnt & " of " & iFndCnt

                ' Get the name of the found file, including the path.
                strFTimp = .FoundFiles(iFCnt)

                ' List files to ignore here.
                If strFTimp = strApplicationPath & strSaveFromPath & "\Failed Attempts active.csv" Then GoTo Next_FTimp
                If strFTimp = strApplicationPath & strSaveFromPath & "\Failed Attempts 2003-08-26(13-54-42).csv" Then GoTo Next_FTimp

                ' Set the file name for saving in the table, - 1 removes the \.
                strFileName = Right(strFTimp, Len(strFTimp) - Len(strApplicationPath) - Len(strSaveFromPath) - 1)

                ' Add a comment to the import status form so that the user knows something is happening.
                Forms!frmImportStatus.txtImportStatus.Value = Forms!frmImportStatus.txtImportStatus.Value & Chr(13) + Chr(10) & _
                                                              Time() & " Checking if '" & strFileName & "' has already been imported"

                ' Check that the file has not yet been imported.
                If fFileImported(strFTimp) = False Then

                    ' Add the name of the file tmpFilesToImport.
                    ' Goto the last record.
                    If Not rstFTimp.EOF Then rstFTimp.MoveLast

                    ' Add a comment to the import status form so that the user knows something is happening.
                    Forms!frmImportStatus.txtImportStatus.Value = Forms!frmImportStatus.txtImportStatus.Value & Chr(13) + Chr(10) & _
                                                                  Time() & " Adding file name to tblFilesToImport"

                    ' Add the new record - saves only the file name, not the path.
                    rstFTimp.AddNew
                    rstFTimp.Fields("strFileToImportName").Value = strFileName
                    rstFTimp.Update

                    ' Add a comment to the import status form so that the user knows something is happening.
                    Forms!frmImportStatus.txtImportStatus.Value = Forms!frmImportStatus.txtImportStatus.Value & Chr(13) + Chr(10) & _
                                                                  Time() & " Copying the file '" & strFileName & "' to the import from location"

                    ' Copy the file to import to the import location.
                    FileCopy strFTimp, strApplicationPath & strImportFromPath & "\" & strFileName

                    ' Add a comment to the import status form so that the user knows something is happening.
                    Forms!frmImportStatus.txtImportStatus.Value = Forms!frmImportStatus.txtImportStatus.Value & Chr(13) + Chr(10) & _
                                                                  Time() & " Importing data from the file '" & strFileName & "'"

                    ' Import the data from the CSV file just copied.
                    '

                Else:

                    ' Add a comment to the import status form so that the user knows something is happening.
                    Forms!frmImportStatus.txtImportStatus.Value = Forms!frmImportStatus.txtImportStatus.Value & Chr(13) + Chr(10) & _
                                                                  Time() & " '" & strFileName & "' Already imported"

                End If
Next_FTimp:
            ' Check the next file.
            Next iFCnt

        Else:

            ' Add a comment to the import status form so that the user knows something is happening.
            Forms!frmImportStatus.txtImportStatus.Value = Forms!frmImportStatus.txtImportStatus.Value & Chr(13) + Chr(10) & _
                                                          Time() & " No files to import"

        End If

    End With

    ' Clear and close recordset, database and other objects.
    rstFTimp.Close
    dbFTimp.Close

    Set rstFTimp = Nothing
    Set dbFTimp = Nothing
    Set objFS = Nothing

    ' Add a comment to the caption of tstCodeTesting so that the user knows something is happening.
    Forms!tstCodeTesting.Caption = "Processing Complete"
    Forms!frmImportStatus.txtImportStatus.Value = Forms!frmImportStatus.txtImportStatus.Value & Chr(13) + Chr(10) & _
                                                  Time() & " Processing Complete"

End Sub

 

[geko]

The next snippet checks to see if the file identified from the previous has already been imported or not.

Public Function fFileImported(strFImp As String) As Boolean

'==========
'
'   Function:
'   fFileImported
'
'   Purpose:
'   To check if a file specified by strFImp has already been imported or not.
'
'   Parameters In:
'   strFImp             The file to check if it has already been imported or not.
'
'   Returns:
'   True                    If the file has been imported.
'   False                   If the file has not been imported.
'
'==========

Dim dbFImp As Database          ' Database object.
Dim rstFImp As Recordset        ' Recordset object.
Dim iFImp As Integer            ' Counter integer.

    ' Create the database and recordset objects.
    Set dbFImp = CurrentDb()
    Set rstFImp = dbFImp.OpenRecordset("tblFilesImported", dbOpenDynaset)

    ' Search through the records in tblFilesImported to see if the file strFImp has already been imported.
    With rstFImp

        ' Get the record count.
        If Not .EOF Then .MoveLast
        iRCnt = .RecordCount

        If Not .BOF Then .MoveFirst

        For iFImp = 1 To iRCnt

            ' Check for a matching file name.
            If strSaveFromPath & "\" & .Fields("strFileImportedName").Value = strFImp Then

                ' File has been imported already exit the function.
                fFileImported = True
                GoTo Exit_Function

            Else:

                ' Keep looking to see if the file has been imported until reach the end of the table.
                fFileImported = False
                .MoveNext

            End If

        Next iFImp

    End With

Exit_Function:

    ' Clear and close the recordset and database objects.
    rstFImp.Close
    dbFImp.Close

    Set rstFImp = Nothing
    Set dbFImp = Nothing

End Function

 

[geko]

The configuration code...

'==========
'
'   Module:
'   modConfig
'
'   Description:
'   Code to read information from tcfgConfig.
'
'   Contents:
'       Global variables relating to the module.
'       sGetConfig                          To get the configuration information from tblConfig.
'
'==========

' MODULE GLOBAL VARIABLES

Public strApplicationPath As String         ' The path that the application is stored in.
Public strImportFileType As String          ' The extension for the type of file to import.
Public strImportFromPath As String          ' The path to import files from.
Public strImportSpecification As String     ' The import specification to use.
Public strImportToTable As String           ' To table to import the data into.
Public strSaveFromPath As String            ' The path that the CSVs are to be saved from.
Public strTransferToTable As String         ' The table to transfer the imported data to.
Public strZipToPath As String               ' The path for the zip archive files.

' FUNCTIONS & ROUTINES

Public Sub sGetConfig()

'==========
'
'   Purpose:
'   To get the configuration information from tblConfig.
'
'==========

Dim dbConf As Database                  ' Database object.
Dim rstConf As Recordset                ' Recordset object.

    Set objFileSys = CreateObject("Scripting.FileSystemObject")

    ' Set the database and recordset objects.
    Set dbConf = CurrentDb()
    Set rstConf = dbConf.OpenRecordset("tcfgConfig")

    ' Get the configuration information.
    With rstConf
        .Index = ("Attribute")

        .Seek "=", "ApplicationPath"
        strApplicationPath = .Fields("strValue").Value

        .Seek "=", "ImportFileType"
        strImportFileType = .Fields("strValue").Value

        .Seek "=", "ImportFromPath"
        strImportFromPath = .Fields("strValue").Value

        .Seek "=", "ImportSpecification"
        strImportSpecification = .Fields("strValue").Value

        .Seek "=", "ImportToTable"
        strImportToTable = .Fields("strValue").Value

        .Seek "=", "SaveFromPath"
        strSaveFromPath = .Fields("strValue").Value

        .Seek "=", "TransferToTable"
        strTransferToTable = .Fields("strValue").Value

        .Seek "=", "ZipToPath"
        strZipToPath = .Fields("strValue").Value

    End With

    ' Close and clear the database and recordset objects.
    rstConf.Close
    dbConf.Close

    Set rstConf = Nothing
    Set dbConf = Nothing

End Sub

 

[geko]

More to follow...

 

[geko]

Code to import data from the files.

Public Sub sImportFiles()

'==========
'
'   Purpose:
'   To import multiple files of type strImportFileType from strImportFromPath, to strImportToTable.
'
'==========

Dim strFileToImport As String       ' The name of the file to import.
Dim iCSVcnt As Integer              ' Counter for number of files imported.

    ' Get the name (including path) of the file(s) to import.
    strFileToImport = Dir(strApplicationPath & strImportFromPath & "\*" & strImportFileType)

    ' Initialise the imported file counter.
    iCSVcnt = 0

    ' Import all files of the type strImportFileType where the name of the file (strFileToImport) is not null.
    Do While Len(strFileToImport) > 0

        ' Add a comment to the import status form so that the user knows something is happening.
        Forms!frmImportStatus.txtImportStatus.Value = Forms!frmImportStatus.txtImportStatus.Value & Chr(13) + Chr(10) & _
                                                      Time() & " Importing data from the file '" & strFileToImport & "'"

        ' Import the file.
        DoCmd.TransferText acImportDelim, strImportSpecification, strImportToTable, strApplicationPath & "\" & strImportFromPath & "\" & strFileToImport, True
        
        ' Get the next file to import.
        strFileToImport = Dir
        
        ' Increment the imported file counter.
        iCSVcnt = iCSVcnt + 1

    Loop

End Sub

 

[cchaalan]

Hi Geko,
I need to create a button for users to click on to open a dialog box that will allow them to select a file (xl or txt delimited) & insert into a predefined Table in Access. Here's what I have so far, but it's not working!
Your help is appreciated!
Private Sub BtnSelect_Click()

Dim dlg As FileDialog ' I get a Compile Error: User-defined type not defined
Set dlg = Application.FileDialog(msoFileDialogFilePicker)
With dlg
.Title = "Select the Excel file to import"
.AllowMultiSelect = False
.Filters.Clear
.Filters.Add "Excel Files", "*.xls", 1
.Filters.Add "All Files", "*.*", 2
If .Show = -1 Then
StrFileName = .SelectedItems(1)
DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel8, "T_FTORNissan", StrFileName, True
Else
Exit Sub
End If
End With

End Sub

 

[geko]

Can't be sure, but maybe the version of access you are using does not have the FileDialog object.

If you are using access 2000 you need a fair amount of code to bring up the file dialog box, but do a search on here for common dialog and that should show you everything you need to know.

Hope that helps for now.

 

[geko]

Otherwise it might be a reference issue, but not having used access 2003/xp I am not sure as to what reference might be missing.

 

[RuralGuy]

Here's the API Link: Call the standard Windows File Open/Save dialog box

 

[nomad00]

Hi Geko,

Your code looks perfect for what I need. Any chance you can send an empty sample database with the table and form structure so I can see how it all works?

Many Thanks