Solved

Revised (Can my code run as a .vbs file? I need to run DBEngine.CompactDatabase, after each file it imports)

Posted on 2013-11-21
9
466 Views
Last Modified: 2013-12-09
I have some import VBA code to import arround 3,500 csv files in to an Access database and that works fine. I'm sourcing 18G of log data. However Access has a 2GB limit and I don't need all the duplicates that are imported. Filtering out many of the columns helps. But in the end instead of the 60K records I imported I only need to see the unique records that will sure to be only around 400 or so.

I want to filter out duplicates for a record and not import them.
For example if I am importing 5 columns I want to identify a duplicate when all five columns have the same data as any previous imported record compared the next row to import. And if there is a duplicate, skip it and move to the next line in the csv file.

so:
1|1|1|1|1 - Imports
1|1|1|1|1 - Dose not import, duplicate across all values for record
1|2|1|1|1 - Imports
0
Comment
Question by:Dooglave
  • 8
9 Comments
 
LVL 6

Author Comment

by:Dooglave
ID: 39666247
This is my import Code:

Sub DoImport()

    Dim fso As Object
    Dim fld As Object
    Dim fil As Object
    Dim FldPath As String
   
    Const DestTable As String = "FABLogs"
   

    FldPath = "C:\Syslogs\"
   
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set fld = fso.GetFolder(FldPath)
   
    With DoCmd
        .SetWarnings True
        For Each fil In fld.Files
            If UCase(Right(fil.Name, 3)) = "CSV" Then
           ' MsgBox "fil.Name is " & fil.Name
           ' MsgBox "fil.path is " & fil.path
                .TransferText acImportDelim, "FABImportLogs", DestTable, fil.path, False
            End If
        Next
        .SetWarnings True
    End With

    Set fil = Nothing
    Set fld = Nothing
    Set fso = Nothing
   
    MsgBox "done"

End Sub

Open in new window

0
 
LVL 6

Author Comment

by:Dooglave
ID: 39666464
Well I think I just did it.  Thinking, make this a function and call it in my other loop between imports.

Public Sub subDeleteLogDups()

   Dim strSQL As String
   Dim objLogRS As DAO.Recordset2
   Dim strPrevRuleName, strPrevAppID, strPrevPort, strPrevProtocol, srtPrevAction

   'Construct SQL statement
   strSQL = "SELECT * FROM logs ORDER BY RuleName, AppID, Port, Protocol, Action"

   'Instantiate objLogRS
   Set objLogRS = CurrentDb.OpenRecordset(strSQL, dbOpenDynaset, dbSeeChanges)

   'First Record
   objLogRS.MoveFirst

   'Loop through Logs
   Do While objLogRS.EOF = False
        If (objLogRS.Fields("RuleName") = strPrevRuleName) And (objLogRS.Fields("AppID") = strPrevAppID) And (objLogRS.Fields("Port") = strPrevPort) And (objLogRS.Fields("Protocol") = strPrevProtocol) And (objLogRS.Fields("Action") = strPrevAction) Then

         'Same Log as Prev Record... delete the record
     objLogRS.Delete

      Else

         'New Log... store new values for Previous Row
         strPrevRuleName = objLogRS.Fields("RuleName")
         strPrevAppID = objLogRS.Fields("AppID")
         strPrevPort = objLogRS.Fields("Port")
         strPrevProtocol = objLogRS.Fields("Protocol")
         strPrevAction = objLogRS.Fields("Action")
         

      End If
      
      'Next Record
      objLogRS.MoveNext

   Loop
   
   'Close RS
   objLogRS.Close

   'Clean Up
   Set objLogRS = Nothing

End Sub

Open in new window

0
 
LVL 6

Author Comment

by:Dooglave
ID: 39666516
Not sure I should modify the registry, seems like I'm just doing something wrong.

hmm getting error when I call the sub with line:
Call subDeleteLogDups()
 
at this line: objLogRS.Delete

Run-time '3052':
FileSharing lock count exceeded. Increase MaxLocksPerFile Registry entry.


    With DoCmd
        .SetWarnings True
        For Each fil In fld.Files
            If UCase(Right(fil.Name, 3)) = "CSV" Then
           ' MsgBox "fil.Name is " & fil.Name
            MsgBox "fil.path is " & fil.path
                .TransferText acImportDelim, "AppIDOnly", DestTable, fil.path, False
            End If
        Call DeleteLogDups
        Next
        .SetWarnings True
    End With

Open in new window

0
 
LVL 6

Author Comment

by:Dooglave
ID: 39666568
Same thing when I put it all in one Sub, same error, same line:

Sub DoImport()

    Dim fso As Object
    Dim fld As Object
    Dim fil As Object
    Dim FldPath As String
    Dim strSQL As String
    Dim objLogRS As DAO.Recordset2
    Dim strPrevRuleName, strPrevAppID, strPrevPort, strPrevProtocol, srtPrevAction
    
   
    Const DestTable As String = "FABLogs"
   

    FldPath = "C:\Syslog\"
   
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set fld = fso.GetFolder(FldPath)
   
    With DoCmd
        .SetWarnings True
        For Each fil In fld.Files
            If UCase(Right(fil.Name, 3)) = "CSV" Then
           ' MsgBox "fil.Name is " & fil.Name
            MsgBox "fil.path is " & fil.path
                .TransferText acImportDelim, "AppIDOnly", DestTable, fil.path, False
            End If
            
            strSQL = "SELECT * FROM FABLogs ORDER BY RuleName, AppID, Port, Protocol, Action"
            Set objLogRS = CurrentDb.OpenRecordset(strSQL, dbOpenDynaset, dbSeeChanges)
            objLogRS.MoveFirst

              Do While objLogRS.EOF = False
                If (objLogRS.Fields("RuleName") = strPrevRuleName) And (objLogRS.Fields("AppID") = strPrevAppID) And (objLogRS.Fields("Port") = strPrevPort) And (objLogRS.Fields("Protocol") = strPrevProtocol) And (objLogRS.Fields("Action") = strPrevAction) Then
                  objLogRS.Delete
                Else
                  strPrevRuleName = objLogRS.Fields("RuleName")
                  strPrevAppID = objLogRS.Fields("AppID")
                  strPrevPort = objLogRS.Fields("Port")
                  strPrevProtocol = objLogRS.Fields("Protocol")
                  strPrevAction = objLogRS.Fields("Action")
                End If
                
               objLogRS.MoveNext
              Loop
   
            objLogRS.Close
            Set objLogRS = Nothing
    Next
        .SetWarnings True
    End With

    Set fil = Nothing
    Set fld = Nothing
    Set fso = Nothing
   
    MsgBox "done"

End Sub

Open in new window

0
Comprehensive Backup Solutions for Microsoft

Acronis protects the complete Microsoft technology stack: Windows Server, Windows PC, laptop and Surface data; Microsoft business applications; Microsoft Hyper-V; Azure VMs; Microsoft Windows Server 2016; Microsoft Exchange 2016 and SQL Server 2016.

 
LVL 6

Author Comment

by:Dooglave
ID: 39666597
Well I set:
DAO.DBEngine.SetOption dbmaxlocksperfile, 25000

Deleted the Table, Repaired the Database
Closed Access and re-opened.

I get through three files now it seems before running into the error.

I need a way to clear the locks if I'm going to get through 3500 files.
0
 
LVL 6

Author Comment

by:Dooglave
ID: 39666883
Set to 250000 and now, it's running.  Lets see how far it goes :)
0
 
LVL 6

Author Comment

by:Dooglave
ID: 39667602
I'm starting to hate MS Access.   File grows to 2G, I repair and compact, goes back down to 1.5mb.  Run another batch, over and over and over again.

Is there any better open source databases I can use.  Like MySQL Lite, can I script with that like this?
0
 
LVL 6

Author Comment

by:Dooglave
ID: 39667786
I wonder if I can make my code run as a .vbs file. Then I could do a CompactDatabase command in the loop..... maybe
0
 
LVL 34

Accepted Solution

by:
PatHartman earned 500 total points
ID: 39669604
There is a no code solution:
If you set a unique index on the fields that make the record unique (Access supports up to 10), the TransferText Method will import the unique rows and discard the duplicates.

To create a multi-column index.
1. Open the table in design view.
2. Open the indexes dialog
3. In the first completely empty row.
    3a. Add an index name.
    3b. Select the first column
    3c. Set the unique property to yes
4. In the second and subsequent rows.
    4a. Skip the index name
    4b. Select the next column for the index.

Leaving the index name blank tells Access that all the columns belong to a single index so they are used together.  That means the combination of a+b+c must be unique rather than the individual values of a, b, c.

Another method is to use a query.  This works even if you have more than ten columns.  Link to the file instead of appending it.

Make a totals query.  This will automatically add Group By to the Total row.  For the columns you are not grouping by, change the Total value to First, Min, etc., whatever makes sense.  Usually first would be best.  That way all the values will come from the same record.

The final step is to change the Totals query into an append query.
0

Featured Post

6 Surprising Benefits of Threat Intelligence

All sorts of threat intelligence is available on the web. Intelligence you can learn from, and use to anticipate and prepare for future attacks.

Join & Write a Comment

Suggested Solutions

Over the years I have built up my own little library of code snippets that I refer to when programming or writing a script.  Many of these have come from the web or adaptations from snippets I find on the Web.  Periodically I add to them when I come…
This article is the result of a quest to better understand Task Scheduler 2.0 and all the newer objects available in vbscript in this version over  the limited options we had scripting in Task Scheduler 1.0.  As I started my journey of knowledge I f…
Get people started with the utilization of class modules. Class modules can be a powerful tool in Microsoft Access. They allow you to create self-contained objects that encapsulate functionality. They can easily hide the complexity of a process from…
What’s inside an Access Desktop Database. Will look at the basic interface, Navigation Pane (Database Container), Tables, Queries, Forms, Report, Macro’s, and VBA code.

708 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

20 Experts available now in Live!

Get 1:1 Help Now