Solved

Empty text files afterimport into Ms Access

Posted on 2011-03-04
3
407 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
[X]
Welcome to Experts Exchange

Add your voice to the tech community where 5M+ people just like you are talking about what matters.

  • Help others & share knowledge
  • Earn cash & points
  • Learn & ask questions
  • 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

Industry Leaders: We Want Your Opinion!

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!

Question has a verified solution.

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

Overview: This article:       (a) explains one principle method to cross-reference invoice items in Quickbooks®       (b) explores the reasons one might need to cross-reference invoice items       (c) provides a sample process for creating a M…
Describes a method of obtaining an object variable to an already running instance of Microsoft Access so that it can be controlled via automation.
In Microsoft Access, learn the trick to repeating sub-report headings at the top of each page. The problem with sub-reports and headings: Add a dummy group to the sub report using the expression =1: Set the “Repeat Section” property of the dummy…
With Microsoft Access, learn how to start a database in different ways and produce different start-up actions allowing you to use a single database to perform multiple tasks. Specify a start-up form through options: Specify an Autoexec macro: Us…

763 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