Deleting tables and reimporting

[RichardMGreen]

Hi all

I have a piece of code I've inherited which deletes some tables and imports data to recreate them.
I've tweaked it a little so it only deletes the tables where the files exist in order to recreate them.

Here's the code:-

Option Compare Database
Public I_totalExtracts As Integer
Sub count_tables()
    Dim lTbl As Long
    On Error Resume Next
    I_totalExtracts = 0
    For lTbl = 0 To CurrentDb.TableDefs.Count
        If Left(CurrentDb.TableDefs(lTbl).Name, 3) = "ext" Then
            I_totalExtracts = I_totalExtracts + 1
        End If
    Next lTbl
    I_totalExtracts = I_totalExtracts - 1
    On Error GoTo 0
End Sub
Sub dropTables(filepath As String)
    DoCmd.SetWarnings False
    UserForm1.Label1.Caption = "Deleting current data....."
    UserForm1.Repaint
    Call count_tables
    For counter = 1 To I_totalExtracts
        Select Case counter
            Case 1: fname = "ext_Activities"
            Case 2: fname = "ext_Assessments"
            Case 3: fname = "ext_Clients"
            Case 4: fname = "ext_Contacts"
            Case 5: fname = "ext_Maintenance"
            Case 6: fname = "ext_PHPGoals"
            Case 7: fname = "ext_PostAssessments"
            Case 8: fname = "ext_Reviews"
            Case 9: fname = "ext_Wellbeing"
        End Select
        file = filepath & fname & ".csv"
        If FileExists(file) Then
            DoCmd.DeleteObject acTable, fname
        End If
        UserForm1.ProgressBar1.Value = UserForm1.ProgressBar1.Value + 5
        UserForm1.Repaint
    Next counter
    DoCmd.SetWarnings True
End Sub
Sub importData(filepath As String)
    Dim i, errorType As Integer, msgboxtext As String
    Dim file, errorResult, errorResultDescription As String
    i = 0
    errorType = 0
    On Error GoTo errhandler:
    If LCase(Left(filepath, 1)) = "c" Then
        msgboxtext = "Storing data on your C drive is not secure unless the drive is encrypted. " & vbCrLf & vbCrLf
    End If
    msgboxtext = msgboxtext & "Please Note - All downloaded files will be moved to the recycle bin after import." _
        & vbCrLf & vbCrLf & "Please ensure the bin is empty after the import is completed."
    response = MsgBox(msgboxtext, vbOKOnly, "Data protection")
    'run it
    For counter = 1 To I_totalExtracts
        Select Case counter
            Case 1: fname = "ext_Activities.csv"
            Case 2: fname = "ext_Assessments.csv"
            Case 3: fname = "ext_Clients.csv"
            Case 4: fname = "ext_Contacts.csv"
            Case 5: fname = "ext_Maintenance.csv"
            Case 6: fname = "ext_PHPGoals.csv"
            Case 7: fname = "ext_PostAssessments.csv"
            Case 8: fname = "ext_Reviews.csv"
            Case 9: fname = "ext_Wellbeing.csv"
        End Select
        file = filepath & fname
        DoCmd.TransferText acImportDelim, "", Left(fname, Len(fname) - 4), file, True, ""
        If FileExists(file) Then
            UserForm1.Label1.Caption = fname & " successfully imported"
            Kill file
            UserForm1.ProgressBar1.Value = UserForm1.ProgressBar1.Value + 5
        End If
        UserForm1.Repaint
    Next counter
    If Len(errorResult) > 0 And i < I_totalExtracts Then
        errorResult = CStr(I_totalExtracts - i) & " files were successfully imported, view 'Tables' to review these." _
            & vbCrLf & vbCrLf & "NB: The following files were not found:" & vbCrLf & errorResult
    ElseIf i > I_totalExtracts - 1 Then
        errorResult = "Unfortunately your files were not found:" & vbCrLf & errorResult
        errorResult = errorResult & vbCrLf & "These tables are not up to date.  Please download and import."
    Else
        errorResult = "All your files were successfully imported"
    End If
    If errorType > 0 Then
        If MsgBox(errorResult & vbCrLf & "WOULD YOU LIKE TO VIEW THE TECHNICAL DETAILS OF THE ERROR(S)?", vbYesNo) = vbYes Then
            MsgBox (errorResultDescription)
        End If
    Else
        MsgBox errorResult
    End If
    If i < I_totalExtracts Then
        DoCmd.SetWarnings False
        DoCmd.RunSQL ("update z_admin set LastImported = '" & Now() & "', DefaultLocation = '" & filepath & "'")
        DoCmd.SetWarnings True
    End If
    UserForm1.Label1.Caption = "Checking for missing items to be added to master tables"
    If DCount("*", "qry_New_Referall_List") > 0 Then
        DoCmd.OpenQuery "qry_New_Referall_List", acViewNormal
    End If
    If DCount("*", "qry_New_Referral_Source_List") > 0 Then
        DoCmd.OpenQuery "qry_New_Referral_Source_List", acViewNormal
    End If
    If DCount("*", "qry_New_Signpost_List") > 0 Then
        DoCmd.OpenQuery "qry_New_Signpost_List", acViewNormal
    End If
    Unload UserForm1
    Exit Sub
errhandler:
    If file <> "" Then
        errorResult = errorResult & file & " could not be imported. " & vbCrLf
        If Err.Number <> 3011 Then 'error other than file not found
            errorResultDescription = errorResultDescription & file & " not imported, reason given: " & Err.Description & vbCrLf
            errorType = 1 'trigger review error details option
        End If
        Debug.Print errorResult
        i = i + 1
        Resume Next
    End If
End Sub
Private Function FileExists(fname) As Boolean
'----- Returns TRUE if the file exists -----
    Dim x As String
    x = Dir(fname)
    If x <> "" Then FileExists = True Else FileExists = False
End Function

Three questions:-
Do I need to delete the tables before the import or can I just get the VBA to import them in order to replace the current table with the new?
How would I loop through the files (all CSV) that have been downloaded without having to specify what they are called?
Are there any other suggestions for improving the code?

 

[RichardMGreen]

OK, just answered question 1. If I don't delete either the table or the contents then the new data is appended to the current table.

Anyone any comments on questions 2 or 3?

 

[Joe4]

If you search the Access forums for something like "loop through files in a folder", you will find many hits. Here is one example, that I think has the code you are looking (see post #1 here: http://www.mrexcel.com/forum/showthread.php?t=542261).

Personally, I find it works much better to just delete the data in the table instead of dropping the whole data. That way, you can ensure that the data formats, indexes, primary keys, etc. are exactly as you want them to be. You can delete the old data out with a simple VBA line like this:

DoCmd.RunSQL "DELETE [Table1].* FROM [Table1]"

 

[RichardMGreen]

Thanks for that, I'll have a look.
That should help me strip out some unecessary coding as well.

 

[RichardMGreen]

Brilliant!!

Got it working a lot quicker and with far less code now.
Thanks for the pointer.

 

[Joe4]

Glad it helped out!