Solved

Empty text files afterimport into Ms Access

Posted on 2011-03-04
3
406 Views
Last Modified: 2012-08-14
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

Open in new window

0
Comment
Question by:budorat
  • 2
3 Comments
 
LVL 1

Accepted Solution

by:
hogwell earned 500 total points
ID: 35041642
At Line 51, you could use this to clear out the file that has been imported:

'Delete old file
Kill strFile
'Create a new, empty file
Dim Lun As Integer
Lun = FreeFile
Open strFile For Output As Lun
Close #Lun

0
 
LVL 5

Author Comment

by:budorat
ID: 35041688
Hi hogwell,

I am getting an error, "Error 53, File not Found"

I then adjusted it to

        Kill strPMKeySFilePath & strFile           'Delete old file
        Dim Lun As Integer      'Create a new, empty file
        Lun = FreeFile
        Open strPMKeySFilePath & strFile For Output As Lun
        Close #Lun

and it now works fine. Thanks.

Kev

0
 
LVL 5

Author Closing Comment

by:budorat
ID: 35041691
Excellent solution, I would love to understand exactly what it is doing.

Thanks Kev
0

Featured Post

U.S. Department of Agriculture and Acronis Access

With the new era of mobile computing, smartphones and tablets, wireless communications and cloud services, the USDA sought to take advantage of a mobilized workforce and the blurring lines between personal and corporate computing resources.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

Suggested Solutions

Title # Comments Views Activity
corrupt Databases 9 65
Access 2010 change CurrentUser 5 33
Comparison query - 4 columns 9 25
Access - Rounding an average in a report 3 16
As tax season makes its return, so does the increase in cyber crime and tax refund phishing that comes with it
Preparing an email is something we should all take special care with – especially when the email is for somebody you may not know very well. The pressures of everyday working life stacked with a hectic office environment can make this a real challen…
Using Microsoft Access, learn some simple rules for how to construct tables in a relational database. Split up all multi-value fields into single values: Split up fields that belong to other things into separate tables: Make sure that all record…
In Microsoft Access, when working with VBA, learn some techniques for writing readable and easily maintained code.

861 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question