Solved

Empty text files afterimport into Ms Access

Posted on 2011-03-04
3
401 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

How to run any project with ease

Manage projects of all sizes how you want. Great for personal to-do lists, project milestones, team priorities and launch plans.
- Combine task lists, docs, spreadsheets, and chat in one
- View and edit from mobile/offline
- Cut down on emails

Join & Write a Comment

This article is a continuation or rather an extension from Cascading Combos (http://www.experts-exchange.com/A_5949.html) and builds on examples developed in detail there. It should be understandable alone, but I recommend reading the previous artic…
I see at least one EE question a week that pertains to using temporary tables in MS Access.  But surprisingly, I was unable to find a single article devoted solely to this topic. I don’t intend to describe all of the uses of temporary tables in t…
Show developers how to use a criteria form to limit the data that appears on an Access report. It is a common requirement that users can specify the criteria for a report at runtime. The easiest way to accomplish this is using a criteria form that a…
In Microsoft Access, learn how to use Dlookup and other domain aggregate functions and one method of specifying a string value within a string. Specify the first argument, which is the expression to be returned: Specify the second argument, which …

744 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

Need Help in Real-Time?

Connect with top rated Experts

12 Experts available now in Live!

Get 1:1 Help Now