Merging Dbase3 dbf files to create single access database table. 2

[CliffordTheRedDog]

I am still in the process of converting our company steel control to Access from dbase3. As the data changes on a hourly basis i have set up macros to copy the data over when we go live. There is one area that currently is a problem due to the way the Dbase database files have been set up. We have 1995 (*.dbf) files that contain the Parts List data for each product. we have a dbase macro (prg)that will compile a new table, but this requires manually inputting the 1995 product names.
I have a text list for (dabase3) databases IE
a.dbf
b.dbf
c.dbf etc

These databases consist of two fields each Partnum Quantity examples shown below.
a.dbf
Partnum Quantity
1024 2
1025 3
1026 1

b.dbf
1024 1
1027 1

c.dbf
1022 1
1023 1
1024 5

I need to transfer all the contents to a single Access 2002 database with three fields Product Partnum Quantity Product being taken from the dbf name. The final result would look like this

Product Partnum Quantity
a 1024 2
a 1025 3
a 1026 1
b 1024 1
b 1027 1
c 1022 1
c 1023 1
c 1024 5
etc

is there a way to do this?
TIA
Cliff

 

[JonFer]

Sure it can be done.

1. Import your dbf file list into an Access table. Easier to work with this way.

2. Link one of the dbf tables and rename it to "ProductParts".

3. Create a query with a parameter for the Product value (a, b, c in your example) that appends data from "ProductParts" to your destination table. Don't run the query yet. You can build the SQL in the VBA module, too, but it's easy to get the syntax wrong.

4. Create a function that links a dbf file but make the Access name the same ("ProductParts&quot regardless of which table is linked. Here is a piece of code so you can see the important steps. The dbase connection syntax may be wrong - I used it for Foxpro tables. There are examples in help.

    ' Example format:  "dBASETable", "dBase IV;DATABASE=C:\dBASE\", "Accounts"

    db1.TableDefs.Delete "ProductParts"
    Set tableLink = db1.CreateTableDef("ProductParts")
    tableLink.Connect = "dBASETable", "dBase IV;DATABASE=" & strDir, strDbfTable
    tableLink.SourceTableName = TableNameExt    
    db1.TableDefs.Append tableLink

5. Write a subroutine that opens your table of files as a recordset. Set a querydef object to the append query you created above.

6. For each record you should link the table, set the query parameter to the Product value, and then execute the query.

 

[CliffordTheRedDog]

Jonfer,
Thanks for the reply will respond as soon as i have digested the instructions.
Cliff

 

[CliffordTheRedDog]

Jonfer,
Again thanks for your help as i'm sure your very busy!
This is my "understanding" so far...

Step 1 Ok

Step 2 ok (i understand that this does not rename the original but only the linked table in access)

step 3 I do not understand if append query requires manual criteria input or if it can take it sequentially from my text list.

step 4 Row by row as i see it.
' comment regarding the format of the origin table?
' Example format: "dBASETable", "dBase IV;DATABASE=C:\dBASE\", "Accounts"
' This deletes the product after the append query has run once?
db1.TableDefs.Delete "ProductParts"
' This recreates the table?
Set tableLink = db1.CreateTableDef("ProductParts&quot
' This populates the table? if so from where?
tableLink.Connect = "dBASETable", "dBase IV;DATABASE=" & strDir, strDbfTable
' Not sure??
tableLink.SourceTableName = TableNameExt
' runs append query?
db1.TableDefs.Append tableLink

step 5
I have no idea how to do this i'm afraid.

step 6
if this means that i have to input each product manually i am not saving any work so i must assume this is automatically done, but i'm not sure how.
i will look at the examples in help to see if i can get any more clarity on what you have said.
Thanks
Cliff

 

[MichaelRed]

I took a few (lot?) of liberties, but the following could be used to see how to construct a set of procedures to capture the information. Some of the liberties:

[tab]I do not currently have any dbase apps, so declined to create the dbf files to manipulate, but copied the INFORMATION to a set (of three) text files. A dbase compatible driver would be preferable. If you have (and can use) the dbase files and driver, the procedure basGrabFile can be omitted. If you have the files which describe the dbase file structures (or know them explicitly), you can also omit the "Split" and just loop through the fields of the individual dbase files for the "ProdId" and "PrtQty" fields.

Of course, if you are opening the dbase files directly, you can examine them individually to see if they match the structure of your product files, so you can just open all of the .dbf's in the possible domain, check for the proper structure and procede (or not) based on the fields.

So, the below 'Code' is more of an approach than a soloution.

Public Function basGetProds()

    Dim FilNum As Integer
    Dim FilNam As String
    Dim MyPrdt As String
    Dim MyPath As String
    Dim MyMsg As String
    Dim MyTitle As String
    Dim MyAry As Variant
    Dim Idx As Long

    'Make sure an EMPTY Table Exists
    If (basCreProdTbl <> True) Then
        MyMsg = &quot;Product Table Error, Exiting&quot;
        MyTitle = &quot;tblProd ERROR&quot;
        GoTo ErrExit
    End If

    MyPath = &quot;C:\My Documents\MsAccess\&quot;

    'First File Check
    FilNam = Dir(MyPath & &quot;tblProd?.Txt&quot;)

    Do While FilNam <> &quot;&quot;

        'Found a file, get it
        MyAry = Split(basGrabFile(MyPath & FilNam), vbCrLf)

        If (UBound(MyAry) < 0) Then
            MyMsg = &quot;File Content Error, Exiting&quot;
            MyTitle = &quot;basGrabFile or Split ERROR&quot;
            GoTo ErrExit
        End If


        MyPrdt = Left(FilNam, InStr(FilNam, &quot;.&quot;) - 1)

        'Add Contents to New Table
        If (basAppendProds(MyPrdt, MyAry) <> True) Then
            MyMsg = &quot;Adding Product Records Error, Exiting&quot;
            MyTitle = &quot;Appending &quot;
            GoTo ErrExit
        End If

        FilNam = Dir

    Loop

NormExit:
    Exit Function

ErrExit:
    MsgBox MyMsg, vbOKOnly, MyTitle
    GoTo NormExit


End Function
Public Function basCreProdTbl() As Boolean

    'M. Red 1/27/2003   Generates an empty recordset of &quot;tblProdParts&quot;. _
                        If the recordset exists, It deletes all records, _
                        otherwise it creates it.

    Dim dbs As DAO.Database
    Dim rst As DAO.Recordset
    Dim tdf As TableDef
    Dim strSQL As String

    On Error GoTo CreTDF

    Set dbs = CurrentDb
    Set rst = dbs.OpenRecordset(&quot;tblProdParts&quot;)

    On Error GoTo ErrExit

    strSQL = &quot;Delete * from tblProdParts&quot;
    DoCmd.SetWarnings False
    DoCmd.RunSQL strSQL
    DoCmd.SetWarnings True
    basCreProdTbl = True
    GoTo NormExit

CreTDF:
    Set tdf = dbs.CreateTableDef(&quot;tblProdParts&quot;)

    With tdf
        .Fields.Append .CreateField(&quot;ProdNm&quot;, dbText, 50)
        .Fields.Append .CreateField(&quot;ProdId&quot;, dbLong)
        .Fields.Append .CreateField(&quot;PrtQty&quot;, dbLong)
    End With
 
    dbs.TableDefs.Append tdf
    basCreProdTbl = True
 
NormExit:
    Set tdf = Nothing
    Set rst = Nothing
    Exit Function

ErrExit:
    basCreProdTbl = False
    GoTo NormExit

End Function
Public Function basGrabFile(FilIn As String) As String

    'Michael Red    3/3/2003
    'Sample Usage:  ? basGrabFile(&quot;C:\MsAccess\DrawArcsInVB.Txt&quot;)
    'Note the Arg [FilIn] is the FULLY QUALIFIED PATH of the Source _
     and the entire text is returned to the caller [prog | procedure]

    Dim MyFil As Integer
    Dim MyTxt As String
    Dim MyPrts() As String
    Dim MyPrtRec() As String

    'Just grab the Stuff
    MyFil = FreeFile

    Open FilIn For Binary As #MyFil

    MyTxt = String(LOF(MyFil), &quot; &quot;)
    Get #MyFil, 1, MyTxt

    Close #MyFil

    basGrabFile = MyTxt

End Function
Public Function basAppendProds(MyPrdt As String, MyAry As Variant) As Boolean

    Dim dbs As DAO.Database
    Dim rst As DAO.Recordset
    Dim Idx As Long

    On Error GoTo ErrExit

    Set dbs = CurrentDb
    Set rst = dbs.OpenRecordset(&quot;tblProdParts&quot;)

    'Add to the Products / Parts
    Idx = 0
    With rst
        While Idx < UBound(MyAry)
            'Append each line to the recordset
            .AddNew
                !ProdNm = MyPrdt
                !ProdId = Val(Left(MyAry(Idx), 8))
                !PrtQty = Val(Right(MyAry(Idx), Len(MyAry(Idx)) - 8))
            .Update
            Idx = Idx + 1
        Wend
    End With

    Set rst = Nothing
    Set dbs = Nothing

NormExit:
    basAppendProds = True
    Exit Function

ErrExit:
    GoTo NormExit

End Function

MichaelRed
m.red@att.net

Searching for employment in all the wrong places

 

[CliffordTheRedDog]

MichaelRed
Wow that's a lot of info, thanks for your assistance I will digest and respond.
Cliff

 

[JonFer]

Because it appears you don't have a lot of VBA programming experience, here is a little more help. It doesn't have error checking but will do the job for a one-time conversion.

I assume you imported your dbf list into a table called "ProductParts" and it has a FileName field (e.g. "a.dbf&quot and a DirectoryName field ("e.g C:\dbaseIII\&quot. This should be easy to do.

The query "qryAppendProductParts" should append records from ProductParts table to your final table. Add a parameter (Query/Parameters menu option in Query Design) called ProductCode.

Next you create a module and copy this into it.

Sub ImportDbase3List()

    Dim db1 As Database
    Dim rsDbfTables As Recordset
    Dim qdAppend As QueryDef
    Dim strProduct As String
    Dim strDir As String, strFileName As String
    
    Set db1 = CurrentDb
    Set qdAppend = db1.QueryDefs("qryAppendProductParts")
    Set rsDbfTables = db1.OpenRecordset("ProductPartsList")
    
    ' look through list of dbf files
    While Not rsDbfTables.EOF
    
        ' delete ProductParts table (linked for creation of append query)
        db1.TableDefs.Delete "ProductParts"
       
        ' get data from dbf list (filename, directory name, determine product code)
        strDir = rsDbfTables!DirectoryName
        strFileName = rsDbfTables!FileName
        strProduct = Left(strFileName, InStr(strFileName, ".") - 1)
       
        ' link DBASEIII table but call it "ProductParts"
        DoCmd.TransferDatabase acLink, "DBASE III", strDir, acTable, strFileName, "ProductParts"
    
        ' set query parameter named "Product" (created in Query Design) to strProduct (derived from filename above)
        qdAppend!ProductCode = strProduct
        ' run query
        qdAppend.Execute
    
        rsDbfTables.MoveNext
    
    Wend

End Sub

 

[CliffordTheRedDog]

Jonfer,
"Because it appears you don't have a lot of VBA programming experience" - How wise you are
Yes unfortunately i'm the best we've got so from this end i look like an expert - "Big fish little pond scenario?" but we know the real truth! I do learn quick though, and appreciate your help! thanks for simplifying.
I have been 3.5hrs on this and will continue tryng to assimulate the processes and instructions but could you help a little further?

Step 1
"I assume you imported your dbf list into a table called "ProductParts" and it has a FileName field (e.g. "a.dbf&quot and a DirectoryName field ("e.g C:\dbaseIII\&quot."
I have. do i need to create PartNum and Quantity field also in this table ie does it populate with more data or is this purely used as a source for determining which dbf files to transfer?

Step 2
"The query "qryAppendProductParts" should append records from "ProductParts" table to your final table (my final table is called "Location table&quot. Add a parameter (Query/Parameters menu option in Query Design) called ProductCode."

Parameter type set to text?

I have looked at the help for parameters and it does not clarify for me. do i need to create an empty "ProductPartsList" table or is this done by the module? My thinking is i need something to append from and to in the append query. or is the query empty other than the parameter?

Step 3
Creat module and paste your code (saved as module1 ok?) Done, but when i run i get the following error.
"user-defined type not defined"!
-> Sub ImportDbase3List()
' next line down "db1 As Database" is shown in bold
Dim db1 As Database

Question.
I know i can try this and it's a 50/50 answer but does the append query invoke the module (i think not) or does the module run the query (This makes more sense) I would like to understand/learn rather than simply monkeysee/monkeydo
Thanks again
Cliff

 

[JonFer]

This should help.

Step 1
Sorry for the confusion, I had the tables named wrong in my instructions. I intended ProductPartsList to have just the list of dbf files so just the two fields there.

Your "Location" table should have 3 fields (Product, PartNum, and Quantity) and be empty at the start of this. It should be appended to in your query from ProductParts.

Step 2
The query "qryAppendProductParts" should append records from "ProductParts" table (which is the linked dbf table) to "Location table".

Make sure you also add the ProductCode field to the query field list (so the query should have 3 columns) and set it to append to the appropriate field in your Location table.

Parameter type set to text -> YES

The query SQL should look like this:

PARAMETERS ProductCode Text;
INSERT INTO Location ( Product, PartNum, Quantity )
SELECT [ProductCode] AS Expr1, PartNum, Quantity
FROM ProductParts;


Step 3
You are probably getting the error because you are using Access 2K and need to select the DAO reference. Open your module and then select the Tools/References menu item. Scroll down until you find a "Microsoft DAO 3.x" entry and check the one with the highest number after DAO. Then REPLACE the Dim statements for the three lines below in the module.

Dim db1 As DAO.Database
Dim rsDbfTables As DAO.Recordset
Dim qdAppend As DAO.QueryDef

Question->Answer
The module runs the query. The ".Execute" method in the module does it.

 

[CliffordTheRedDog]

Jonfer,
Thanks again,
Module no longer errors, it runs very quick
no table changes occurr, i may have other things which arnt quite right

qryAppendProductParts sql looks like this:

PARAMETERS ProductCode Text ( 255 );
INSERT INTO [Location Table] ( [Product Number], [Part Number], Qty )
SELECT [ProductCode] AS Expr1, ProductPartsList.[Part Number], ProductPartsList.Qty
FROM ProductParts, [Location Table], ProductPartsList;

The (255)keeps getting put back by the software when i exit and view the sql!

Module looks like this:

PARAMETERS ProductCode Text ( 255 );
INSERT INTO [Location Table] ( [Product Number], [Part Number], Qty )
SELECT [ProductCode] AS Expr1, ProductPartsList.[Part Number], ProductPartsList.Qty
FROM ProductParts, [Location Table], ProductPartsList;


Sub ImportDbase3List()

Dim db1 As DAO.Database
Dim rsDbfTables As DAO.Recordset
Dim qdAppend As DAO.QueryDef
Dim strProduct As String
Dim strDir As String, strFileName As String

Set db1 = CurrentDb
Set qdAppend = db1.QueryDefs("qryAppendProductParts&quot
Set rsDbfTables = db1.OpenRecordset("ProductPartsList&quot

' look through list of dbf files
While Not rsDbfTables.EOF

' delete ProductParts table (linked for creation of append query)
db1.TableDefs.Delete "ProductParts"

' get data from dbf list (filename, directory name, determine product code)
strDir = rsDbfTables!DirectoryName
strFileName = rsDbfTables!FileName
strProduct = Left(strFileName, InStr(strFileName, ".&quot - 1)

' link DBASEIII table but call it "ProductParts"
DoCmd.TransferDatabase acLink, "DBASE III", strDir, acTable, strFileName, "ProductParts"

' set query parameter named "Product" (created in Query Design) to strProduct (derived from filename above)
qdAppend!ProductCode = strProduct
' run query
qdAppend.Execute

rsDbfTables.MoveNext

Wend

End Sub

I cut and paste this direct from my productparts table.
DirectoryName FileName
G:\ 2.DBF
G:\ 2184.DBF

I will look further to see if i have done something silly
Thanks
Cliff

 

[JonFer]

Your append query only needs to use table ProductParts in the "FROM" clause so remove the other two. Are the field names "Part Number" and "Qty" in the dbf tables?

PARAMETERS ProductCode Text ( 255 );
INSERT INTO [Location Table] ( [Product Number], [Part Number], Qty )
SELECT [ProductCode] AS Expr1, ProductParts.[Part Number], ProductParts.Qty
FROM ProductParts;

 

[CliffordTheRedDog]

Jonfer,
dbf tables are Partnum and Quantity
will look more and get back to you.
thanks
Cliff

 

[CliffordTheRedDog]

Jonfer,
When i started this transfer utility I copied the target table location table from the working database into this test database. and the field names in that are not the same ie.
(Final )
Location Table
Product Part Number Qty

dbf table
Partnum Quantity

What i propose to do is use this temporary transfer location table and once proved either reset the target to populate the working (final)database location table or just use a straightforward append command to transfer from this location table to the final location table in the "working" dabase. As this will be a one of procedure i don't mind the two stage way if i find the redirection complicated.

But for now it will be simpler maybe if i rename this temporary location table field names to match the dbf source field names Partnum and Quantity. Obviously I would not want to rename the Final location table field names as there are many utilities and reports based on those that would go belly up.
Thanks
Cliff

 

[CliffordTheRedDog]

Jonfer,
Quick recap of what i have done.
Create table of dbf files/recordset ProductPartsList to import with two fields, dir and filename including ext.

Link one of the dbf files, rename to ProductParts.

create location table with three fields Product PartNum Quantity.

Create append query with Parameter ProductCode, Use paramata as Expr1 to create/append Product in Location table, append product partnum from ProductParts to Location table, append Quantity from ProductParts to Location table Quantity
Create Module and run it.

I have done this and corrected any syntax or misunderstandings i have made.

I run the code and get a runtime '3265' error Item not foun in this collection
> db1.TableDefs.Delete "ProductParts" (is highlighted)
i will investigate, any ideas?
Thanks
Cliff

 

[MichaelRed]

The delete is (or at least WAS) in the loop. It needs to be moved out of it. (or even just done manually).




MichaelRed
m.red@att.net

Searching for employment in all the wrong places

 

[CliffordTheRedDog]

Michael,
Thanks,
I believe that the delete is in the loop, as it's between the while and wend (while end?) statements, beyond that i',m afraid i haven't the foggiest. I am looking at all the coding that I've recieved and trying to figure out where the problem lies but this is where i am so far!

Sub ImportDbase3List()

Dim db1 As DAO.Database
Dim rsDbfTables As DAO.Recordset
Dim qdAppend As DAO.QueryDef
Dim strProduct As String
Dim strDir As String, strFileName As String

Set db1 = CurrentDb
Set qdAppend = db1.QueryDefs("qryAppendProductParts&quot
Set rsDbfTables = db1.OpenRecordset("ProductPartsList&quot

' look through list of dbf files
While Not rsDbfTables.EOF


' delete ProductParts table (linked for creation of append query)
db1.TableDefs.Delete "ProductParts"

' get data from dbf list (filename, directory name, determine product code)
strDir = rsDbfTables!DirectoryName
strFileName = rsDbfTables!FileName
strProduct = Left(strFileName, InStr(strFileName, ".&quot - 1)

' link DBASEIII table but call it "ProductParts"
DoCmd.TransferDatabase acLink, "DBASE III", strDir, acTable, strFileName, "ProductParts"

' set query parameter named "Product" (created in Query Design) to strProduct (derived from filename above)
qdAppend!ProductCode = strProduct
' run query
qdAppend.Execute

rsDbfTables.MoveNext

Wend

End Sub

Thanks
Cliff

 

[JonFer]

The table ProductParts was supposed to be in the database when you run this. If you were testing the subroutine, then it probably deleted it during one round but did not make it to the link step again. Make sure the table is there before you run it. DO NOT REMOVE the delete step.

You can also use the slightly modified version of your code below which will continue even if ProductParts is not already in the database. Note the "On Error" statements surrounding the delete step and the "err_NoTable" section at the bottom.

Sub ImportDbase3List()

    Dim db1 As DAO.Database
    Dim rsDbfTables As DAO.Recordset
    Dim qdAppend As DAO.QueryDef
    Dim strProduct As String
    Dim strDir As String, strFileName As String
    
    Set db1 = CurrentDb
    Set qdAppend = db1.QueryDefs("qryAppendProductParts")
    Set rsDbfTables = db1.OpenRecordset("ProductPartsList")
    
    ' look through list of dbf files
    While Not rsDbfTables.EOF
    
    
        ' delete ProductParts table (linked for creation of append query) but continue if not found
        On Error Go To err_NoTable
        db1.TableDefs.Delete "ProductParts"
        On Error Go To 0

        ' get data from dbf list (filename, directory name, determine product code)
        strDir = rsDbfTables!DirectoryName
        strFileName = rsDbfTables!FileName
        strProduct = Left(strFileName, InStr(strFileName, ".") - 1)
       
        ' link DBASEIII table but call it "ProductParts"
        DoCmd.TransferDatabase acLink, "DBASE III", strDir, acTable, strFileName, "ProductParts"
    
        ' set query parameter named "ProductCode" (created in Query Design) 
        ' to strProduct (derived from filename above)
        qdAppend!ProductCode = strProduct
        ' run query
        qdAppend.Execute
    
        rsDbfTables.MoveNext
    
    Wend

    Exit Sub

err_NoTable:

    ' 3265 - Table not found but okay to continue
    If err.Number = "3265" Then
        Resume Next
    Else
        Msgbox "Error: " & Err.Number & " - " & Err.Description
    End If
    

End Sub

 

[CliffordTheRedDog]

Jonfer,
Thanks will check this out, have not removed delete.
Will be back to you
Cliff

 

[CliffordTheRedDog]

Jonfer,
Yes, yes, Yes, magnificent!!!
Thank you so very much for seeing it through! It worked. I am now so close to releasing the dbase to colleagues.

I had an aborted attempt that left 1500 Temporary dbf files in my dbase. Is there a quick way to delete them? I May have to look at a delete query routine.

Thanks again.
Cliff

 

[CliffordTheRedDog]

Jonfer,
Oops spoke to soon, the routine is adding all parts to all Products.
Product Partnum Quantity
BA4FL 14067 1
BA7FL 14067 1
BA3FL 14067 1
BA4FL 14135 1
BA7FL 14135 1
BA3FL 14135 1
BA4FL 14141 1
BA7FL 14141 1
BA3FL 14141 1
BA4FL 14152 1
BA7FL 14152 1
BA3FL 14152 1
BA4FL 14170 1
BA7FL 14170 1
BA3FL 14170 1
BA4FL 14173 1
BA7FL 14173 1
BA3FL 14173 1
BA4FL 14174 1
BA7FL 14174 1
BA3FL 14174 1
BA4FL 14177 1
BA7FL 14177 1
BA3FL 14177 1
BA4FL 14639 1
BA7FL 14639 1
BA3FL 14639 1

Is the solution simple? Will take a look myself and report back if/when i find it!
Thanks
Cliff