Empty text files afterimport into Ms Access

Hi,

I use the following code to import data from a text file called "Unit_FGS1407_EmergContact*.txt"

The code cycles through the directory and imports multiple sets of data based on the text file if more than one file exists, provided the name starts with "Unit_FGS1407_EmergContact" Eg

Unit_FGS1407_EmergContact.txt
Unit_FGS1407_EmergContact_2.txt
Unit_FGS1407_EmergContact_hello.txt
Unit_FGS1407_EmergContact_goodbye.txt

I would like to be able to delete and recreate a blank version of each text file after the data has been imported, but I have no idea how to go about it. There is almost always going to be at least one file called Unit_FGS1407_EmergContact.txt, but there can be as many as 15 files all with a similar name. We have no control over the naming of the files after "Unit_FGS1407_EmergContact"

I want to be able to delete the file (or just empty it) then recreate it with the same name after all the data has been imported. Any help would be greatly appreciated.

Regards

Kev

Function ImportPMKeySData_EmContact(strTableName As String, Optional CalledBy As String)
'******************************************************
' PURPOSE:              Import Data and update BRT with latest info
' INPUT PARAMETERS:     See inline comments
'******************************************************
On Error GoTo Err_Handler

    DoCmd.SetWarnings False
    Dim strPMKeySFilePath As String, strImportSpec As String, strFile As String
    Dim strMsg As String, strUser As String, sSql As String, strSqlRemoveExcessRecords As String
        
    strUser = Environ("USERNAME")
    
    Dim dbs As DAO.Database
    Set dbs = CurrentDb

    Select Case strTableName

        Case "tblPMKeyS_EmContact"
            strImportSpec = "ImportSpec_PMKeyS_FGS1407_EmContact"
            strFile = "Unit_FGS1407_EmergContact*.txt"
            strSqlRemoveExcessRecords = "DELETE tblPMKeyS_EmContact.[Empl ID], * FROM tblPMKeyS_EmContact WHERE (((tblPMKeyS_EmContact.[Empl ID]) In (SELECT tblPMKeyS_EmContact.[Empl ID] FROM tblPMKeyS_EmContact LEFT JOIN sysqryPersDetailsCurrent ON tblPMKeyS_EmContact.[Empl ID] = sysqryPersDetailsCurrent.EID WHERE (((sysqryPersDetailsCurrent.EID) Is Null)))));"
                                   
        Case "tblPMKeyS_Fmn_EmContact"
            strImportSpec = "ImportSpec_PMKeyS_FGS1407_EmContact"
            strFile = "Fmn_FGS1407_EmergContact*.txt"
            strSqlRemoveExcessRecords = "NA"
            
        Case Else
    End Select
    
    strPMKeySFilePath = DLookup("ImportDataPMKeyS", "systblSettings", "")   'Calculate PMKeyS data file path

    If Right(strPMKeySFilePath, 1) <> "\" Then                              'Check for terminating backslash strPMKeySFilePath filepath.
       strPMKeySFilePath = strPMKeySFilePath & "\"
    End If
    
    If (Dir(strPMKeySFilePath & strFile) > "") = False Then                 'Check import file exists
        MsgBox strFile & " is not saved into the PMKeyS Source Files folder (" & strPMKeySFilePath & "). Check the file exists and named correctly before running this procedure again"
        Exit Function
    Else
    End If
    
    sSql = "DELETE " & strTableName & ".* FROM " & strTableName & ";"     'Delete current data set
    dbs.Execute sSql
    
    strFile = Dir(strPMKeySFilePath & strFile, vbNormal)
    Do While strFile <> ""                                                      'Import new data set
        If strFile <> "." And strFile <> ".." Then
            DoCmd.TransferText acImportDelim, strImportSpec, strTableName, strPMKeySFilePath & strFile, False, ""
        End If
        strFile = Dir()
    Loop

    Call DeleteImportErrTbls                                                'Delete ImportError tables if created
    
    sSql = "Delete " & strTableName & ".[Emergency Contact] FROM " & strTableName & " WHERE (((" & strTableName & ".[Emergency Contact]) Is Null)) OR (((" & strTableName & ".[Emergency Contact])='Emergency Contact'));"
    dbs.Execute sSql
         
'******************************************************************************************************************************************************
    Dim rstEmContact As DAO.Recordset, strEID As String, intRowNumber As Long
    
    Select Case strTableName
    
        Case "tblPMKeyS_EmContact"
        'Add missing employee ID's to Emergency Contact Data
            Set rstEmContact = CurrentDb.OpenRecordset("SELECT * FROM tblPMKeyS_EmContact;")
            rstEmContact.MoveFirst
            Do Until rstEmContact.EOF = True
                strEID = Nz(rstEmContact![Empl ID], "Missing")
                If strEID = "Missing" Then
                 intRowNumber = rstEmContact![RowNumber] - 1
                    With rstEmContact
                        .Edit
                        ![Empl ID] = Nz(DLookup("[Empl ID]", "tblPMKeyS_EmContact", "RowNumber=" & intRowNumber), "XXX")
                        .Update
                    End With
                Else
                End If
                
                rstEmContact.MoveNext
            Loop
                rstEmContact.Close
            
            strMsg = "Emergency Contact "
            sSql = "UPDATE systblSettings SET systblSettings.EmContactBy = " & "'" & strUser & "'" & ", systblSettings.EmContactDTG = Now();"
            
        Case "tblPMKeyS_Fmn_EmContact"
        'Add missing employee ID's to Emergency Contact Data
            Set rstEmContact = CurrentDb.OpenRecordset("SELECT * FROM tblPMKeyS_Fmn_EmContact")
            Do While Not rstEmContact.EOF = True
                strEID = Nz(rstEmContact![Empl ID], "Missing")
                If strEID = "Missing" Then
                 intRowNumber = rstEmContact![RowNumber] - 1
                    With rstEmContact
                        .Edit
                        ![Empl ID] = DLookup("[Empl ID]", "tblPMKeyS_Fmn_EmContact", "RowNumber=" & intRowNumber)
                        .Update
                    End With
                Else
                End If
                
                rstEmContact.MoveNext
            Loop
                rstEmContact.Close
                
            strMsg = "Formation Emergency Contact "
            sSql = "UPDATE systblSettings SET systblSettings.FmnEmContactBy = " & "'" & strUser & "'" & ", systblSettings.FmnEmContactDTG = Now();"

        Case Else
    
    End Select
'******************************************************************************************************************************************************

    'dbs.Execute strSqlCleanup                               'Clean up unwatned records (header data from text files).

    'Remove excess records if Deployable Version or BOSC Administered Unit
    If DLookup("SysDeployableBOSC", "systblSettings", "") = True And strSqlRemoveExcessRecords <> "NA" And DCount("EID", "tblPersDetails", "") <> 0 Then
        dbs.Execute strSqlRemoveExcessRecords
    End If
    
    DoCmd.RunSQL sSql                               'Update PMKeyS Update Info
    Form_frmMaintImportPMKeySData.Requery

'Update complete messagecontrol
    If Len(CalledBy) < 1 Then
        MsgBox strMsg & "data transfer complete" & " " & Environ("USERNAME")
    Else
    End If
    
    dbs.Close

Exit_Handler:
    DoCmd.SetWarnings True
    Exit Function

Err_Handler:
    MsgBox "Error " & Err.Number & " - " & Err.Description, vbExclamation, "ImportPMKeySData_EmContact()"
    Resume Exit_Handler

End Function

Select allOpen in new window