• Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 1162
  • Last Modified:

Convert DIF file format to MDB or DBF


I have problem to open DIF(Data Interchange Format) data file from VB-Visual Data Manager, may I know is there any way to read it, and convert it to either MDB or DBF format?


  • 4
  • 2
1 Solution
If this is a one-off activity:

1) Rename the file to CSV

2) Open the file using excel

3) Add column headings to each of the couumns.

4) Save the file and exit excel

5) Open Access

6) Select File-Get external data

7) Import the CSV file.

If you need to do this frequently using VB, before you can be advised we need to know what version of Access you are trying to update.

layseeAuthor Commented:
I have both version of Access- 97 & 2000, I can use either one, provided it can help to solve my problem.

Actually, I want to import the DIF file directly to VB, instead of going through some many steps.

thank you

The following example creates a table in a database from a dif file.

The lines which you may need to change start with '?

If you are using DAO/ADO don't forget to add the relevant project reference.

Besr of luck, Nick

'==========Sample starts here

Dim wlfn As Long
Dim filename$
Dim ldata$
ReDim vars$(0)
Dim vc As Long
Dim row1Names As Long
Dim delimiter$
Dim firstrow As Boolean
ReDim storednames(0)
ReDim fieldtypes(0)

' if your going to use DAO or ADO don't forget to include the relevant project references.

delimiter$ = ","    ' set the field delimiter

' Get the file name


    filename$ = InputBox$("Enter dif file name", "Select File")
    If Len(filename$) = 0 Then Exit Sub ' no entry nothing to do
    On Error Resume Next
    ' Open the file for sequential input
    wlfn = FreeFile
    Open filename$ For Input Shared As wlfn
    If Err.Number = 0 Then Exit Do      ' Good no error exits loop
    On Error GoTo 0
    MsgBox "Invalid file name", vbExclamation, "Error"

On Error GoTo 0

' Does the first row specify field names ?

row1Names = MsgBox("Does the first row contain field names Y/N", vbYesNo + vbQuestion, "Field Names")

' The first row may contain field names
firstrow = True

' loop until the end of the file is found
Do While Not EOF(wlfn)

    ' Read the next line
    Line Input #wlfn, ldata$
    ' Split the line into an array of fields
    vars = Split(ldata$, delimiter$, -1, vbBinaryCompare)
    ' convert the data
    ' assume that fields starting " are strings remove the double quotes
    ' assume numeric fields with a / in them must be dates
    ' else must be numeric
    ReDim fieldtypes(UBound(vars))
    For vc = 0 To UBound(vars)
        If Left(vars(vc), 1) = Chr$(34) Then    ' The field may be a string
            vars(vc) = Mid$(vars(vc), 2, Len(vars(vc)) - 2) ' remove string field delimiters
            fieldtypes(vc) = "T"    ' you can set the type indicator to anything you like
                                    ' dbText if your using DAO etc.
        ElseIf InStr(vars(vc), "/") > 0 Then    ' Or maybe a date
            vars(vc) = DateValue(vars(vc))      ' if date convert to date value
            fieldtypes(vc) = "D"    ' or dbDate
        Else    ' must be numeric
            vars(vc) = Val(vars(vc))
            fieldtypes(vc) = "N"    ' or dbDouble
        End If
    Next vc
    ' You now have an array with ubound(VARS) fields in it
    ' if it is the first row in the file you may wish to save the field names
    If firstrow And row1Names = vbYes Then
        firstrow = False
        ' Save the field names
        ReDim storednames(UBound(vars))
        For vc = 0 To UBound(vars)
            storednames(vc) = vars(vc)
        Next vc
        ' example of what you may want to do
        ' you may want to create a new table in a database here
        ' or do something else here
        '? Dim DB As DAO.Database
        '? Dim TD As DAO.tabledef
        '? Dim FLD As DAO.Field
        '?  open a database
        '? Set DB = workspaces(0).opendatabase("yourdb.mdb")
        '?  create a new table
        '? Set tb = DB.CreateTableDef("New Table Name")
        '?  create fields in the new table
        '? For vc = 0 To UBound(vars)
        '?     Select Case fieldtypes(vc)
        '?         Case Is = "T": Set FLD = TD.CreateField(storednames(vc), dbText, 255)
        '?         Case Is = "D": Set FLD = TD.CreateField(storednames(vc), dbDate)
        '?         Case Is = "N": Set FLD = TD.CreateField(storednames(vc), dbDouble)
        '?     End If
        '?     ' you can set other attributes (dependes on you database version
        '?     'FLD.Attributes = xxxxx or yyyyy
        '?     tb.Fields.Append FLD ' save the field details in the tabledef.field collection
        '? Next vc
        '?  add the new table and field specs to the database
        '? DB.TableDefs.Append TD
        '?  Open a recordset for the new table
        '? Set RS = DB.OpenRecordset("Select * from [New Table Name];", dbOpenDynaset, dbAppendOnly)
        ' This is where you add your code to process the datavalues
        ' for example you may want to save to a database
        If firstrow And row1Names = vbNo Then
            firstrow = False
            '?  you may want some first time processing here if the file does not contain field names
        End If
        '? ' Add a new record in the recordset
        '? RS.Addnew
        '? for vc = 0 to ubound(vars)
        '?     RS(storednames(vc)) = vars(vc)
        '? Next vc
        '? rs.update
    End If

Close wlfn

' do your finishing code here

'? rs.close
'? db.close
Free Tool: ZipGrep

ZipGrep is a utility that can list and search zip (.war, .ear, .jar, etc) archives for text patterns, without the need to extract the archive's contents.

One of a set of tools we're offering as a way to say thank you for being a part of the community.

Laysee, here is an improved sub & function to import a DIF file into a database.  Don't forget to award the points, thanks...

The Sub SplitCSV takes about half a second per 1000 records. Fast enought to use for big files.

The following example creates a database and imports a table from a csv file with row headings at the
top of file.

The sub returns a variant array of the data

Numerics, Dates and strings are handled.

Strings are returns without quotes.

Strings containing double double quotes are also handled correclty.

Use and enjoy..........Nick....

Step 1 Add a reference to DAO e.g. Microsoft DAO 3.6
Step 2 New Project
Step 3 Create a command button - command1
Step 3 Patse the following code

Private Sub Command1_Click()

'Sub to import a CSV file to a database

ReDim flds(0) As Variant
ReDim fldtypes$(0)
Dim FieldCount As Long
Dim InvalidFormat As Boolean
Dim l$
Dim fc As Long
Dim m$
ReDim fldNames(0) As Variant
ReDim fldtypes$(0)

Dim DB As DAO.Database
Dim RS As DAO.Recordset
Dim TD As DAO.TableDef
Dim FL As DAO.Field

Dim TableName$
Dim DBName$

Dim wlfn As Long

Dim UserOptions$

UserOptions$ = "" ' /ND for no date convertsion and /NN for no numeric conversion

TableName$ = "MyTable"  ' your table name
DBName$ = "c:\temp\MYDatabase.MDB" ' your database name

wlfn = FreeFile
Open "C:\YourFile.CSV" For Input Shared As #wlfn

' get field headers
Line Input #wlfn, l$
Call SplitCSV(l$, fldNames(), fldtypes(), FieldCount, "", InvalidFormat)

Dim DoneOne As Boolean

' read file
Do While Not EOF(wlfn)
   Line Input #wlfn, l$
   Call SplitCSV(l$, flds(), fldtypes(), FieldCount, UserOptions$, InvalidFormat)
   ' Create table
   If Not DoneOne Then
       Set DB = workspaces(0).CreateDatabase(DBName$, dbLangGeneral, dbVersion30)
       Set DB = workspaces(0).opendatabase(DBName$)
       Set TD = DB.CreateTableDef(TableName$)
       For fc = 1 To FieldCount
           Select Case fldtypes(fc)
               Case Is = "T"
                   Set FL = TD.CreateField(fldNames(fc), dbText, 50)
               Case Is = "D"
                   Set FL = TD.CreateField(fldNames(fc), dbDate)
               Case Is = "N"
                   Set FL = TD.CreateField(fldNames(fc), dbDouble)
           End Select
           TD.Fields.Append FL
       Next fc
       DB.TableDefs.Append TD
       DoneOne = True
       Set RS = DB.OpenRecordset("Select * from [" + TableName$ + "];", dbOpenDynaset, dbAppendOnly)
   End If
   For fc = 1 To FieldCount
       RS(fldNames(fc)) = flds(fc)
   Next fc

Close wlfn

End Sub

Public Sub SplitCSV(StringToSplit As String, ReturnArray() As Variant, ReturnTypes() As String, FieldCount
As Long, UserOptions$, InvalidFormat As Boolean)

' Subroutine to split CSV lines
' Created by Nick Young
' Date: 15/01/2001
' Please report any bug fixes to nyoung@vipintersoft.com

' Pass Stringtosplit as the line of data to be split
' Returns the following fields:

' ReturnArray() variant containing values either string, date or numeric
' Notes: strings have their "" removed
' Also handles strings like "This text has a "" double double quote inside"
' first field is ReturnArray(1)

' returntypes() array of type of data that was found
' T=Text, N=Numeric, D=Date, E=Empty field
' FieldCount is returned as the number of fields, 1=first field

' FormatError is set if the file is invalid

' UserOptions /ND = no dates conversion /NN No numeric conversion
' if /ND is specified then dates are returned as strings
' if /NN is specified numerics are returnd as strings

' Example:
' Redim Flds() as variant
' Redim FldTypes$()
' Dim FieldCount as long
' Dim InvalidFormat as boolean
' call SplitCSV(L$, Flds(), FldTypes(), FieldCount,"",InvalidFormat)

Static Fieldslasttime As Long

If Fieldslasttime = 0 Then
   Fieldslasttime = 100
End If

ReDim ReturnArray(Fieldslasttime)
ReDim ReturnTypes(Fieldslasttime)

Dim CPos As Long    ' next comma
Dim LPos As Long    ' last comma

Dim FieldLength As Long

Dim StringDelimiter As Long
Dim Delimiter$
Dim SS$     ' string to split

' handle double quotes
Dim DoubleDoubleFound As Boolean
Dim StartFromPos As Long
Dim XPos As Long    ' postion of "
Dim DV As Date
Dim NV As Double

Dim ConvertDates As Boolean
Dim ConvertNumerics As Boolean

ConvertDates = True
ConvertNumerics = True

If Len(UserOptions$) = 0 Then
   SS$ = UCase$(UserOptions)
   If InStr(SS$, "/ND") Then
       ConvertDates = False
   End If
   If InStr(SS$, "/NN") Then
       ConvertNumerics = False
   End If
End If

SS$ = Trim$(StringToSplit)

StringDelimiter = 34 ' Double quote
Delimiter$ = ","
Dim StringLength As Long

StringLength = Len(SS$)

FieldCount = 0
LPos = 0
   'find first comma
   LPos = LPos + 1
   If LPos > StringLength Then
       If Right(SS$, 1) = Delimiter$ Then
           GoSub AddFieldCount ' must be a blank field
       End If
       Exit Do
   End If
   CPos = InStr(LPos, SS$, Delimiter$)
   GoSub AddFieldCount
   If CPos = 0 Then
       CPos = StringLength + 1
   End If
   FieldLength = CPos - LPos
   If FieldLength > 0 Then
       ' Have we found a double quoted string?
       If Asc(Mid(SS$, LPos, 1)) = StringDelimiter Then
           ' so the comma we found may not be the end of the field.
           ' because its a string ther must be another " to find
           StartFromPos = LPos + 1
               XPos = InStr(StartFromPos, SS$, Chr$(StringDelimiter))
               If XPos < 1 Then
                   ' File format error
                   FieldCount = -FieldCount
                   Exit Sub
               End If
               ' But we may have a situation like "Some Text""MoreText"
               If XPos >= StringLength Then Exit Do
               If Asc(Mid(SS$, XPos + 1, 1)) <> StringDelimiter Then Exit Do
               ' we need to keep searching for next single double quote
               DoubleDoubleFound = True
               StartFromPos = XPos + 2
           If CPos < XPos Then
               ' need to find next comma after string delimiter
               CPos = InStr(XPos, SS$, Delimiter$)
               If CPos = 0 Then
                   CPos = StringLength + 1
               End If
           End If

           FieldLength = XPos - LPos - 1
           ' So we now have a quoted string string
           ReturnTypes(FieldCount) = "T"
           If FieldLength > 0 Then
               ReturnArray(FieldCount) = Mid(SS$, LPos + 1, FieldLength)
               If DoubleDoubleFound Then
                   ReturnArray(FieldCount) = Replace(ReturnArray(FieldCount), Chr$(StringDelimiter)
+ Chr$(StringDelimiter), Chr$(StringDelimiter), 1, -1)
               End If
               ReturnArray(FieldCount) = ""
           End If
           ReturnArray(FieldCount) = Mid(SS$, LPos, FieldLength)
           If InStr(ReturnArray(FieldCount), "/") > 0 Then
               ' must be a date
               ReturnTypes(FieldCount) = "D"
               If ConvertDates Then
                   On Error Resume Next
                   DV = DateValue(ReturnArray(FieldCount))
                   If Err.Number = 0 Then
                       ReturnArray(FieldCount) = DV
                       InvalidFormat = True
                   End If
                   On Error GoTo 0
               End If
               ' must be a number
               ReturnTypes(FieldCount) = "N"
               If ConvertNumerics Then
                   On Error Resume Next
                   NV = Val(ReturnArray(FieldCount))
                   If Err.Number = 0 Then
                       ReturnArray(FieldCount) = NV
                       InvalidFormat = True
                   End If
                   On Error GoTo 0
               End If
           End If
       End If
   End If
   LPos = CPos

If FieldCount <> Fieldslasttime Then
   Fieldslasttime = FieldCount
   ReDim Preserve ReturnArray(Fieldslasttime)
   ReDim Preserve ReturnTypes(Fieldslasttime)
End If

Exit Sub


FieldCount = FieldCount + 1

If FieldCount > UBound(ReturnArray) Then
   ReDim Preserve ReturnArray(FieldCount + 50)
   ReDim Preserve ReturnTypes(FieldCount + 50)
End If
ReturnArray(FieldCount) = Null
ReturnTypes(FieldCount) = "E"


End Sub
Laysee, thanks for the points.  How could I improve the code so that you would have given a grade A answer?  Did the code not achieve what you wanted?

layseeAuthor Commented:

Actually your code gave me an idea, to solved my major problem on converting the file.

I credited the points so late, is because I'm troubleshooting on my program, and make sure it works!


Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.

Join & Write a Comment

Featured Post

Free Tool: Path Explorer

An intuitive utility to help find the CSS path to UI elements on a webpage. These paths are used frequently in a variety of front-end development and QA automation tasks.

One of a set of tools we're offering as a way of saying thank you for being a part of the community.

  • 4
  • 2
Tackle projects and never again get stuck behind a technical roadblock.
Join Now