Still celebrating National IT Professionals Day with 3 months of free Premium Membership. Use Code ITDAY17

x
?
Solved

Convert DIF file format to MDB or DBF

Posted on 2001-02-15
6
Medium Priority
?
1,135 Views
Last Modified: 2012-08-14
Hi,

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?

regards.

laysee
0
Comment
Question by:laysee
[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
  • 4
  • 2
6 Comments
 
LVL 17

Expert Comment

by:inthedark
ID: 5849089
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.

0
 

Author Comment

by:laysee
ID: 5851464
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

laysee
0
 
LVL 17

Expert Comment

by:inthedark
ID: 5885592
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

Do

    filename$ = InputBox$("Enter dif file name", "Select File")
    If Len(filename$) = 0 Then Exit Sub ' no entry nothing to do
   
    On Error Resume Next
    Err.Clear
    ' 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"
           
Loop

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)
       
    Else
   
        ' 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
Loop

Close wlfn

' do your finishing code here

'? rs.close
'? db.close
0
Independent Software Vendors: 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!

 
LVL 17

Accepted Solution

by:
inthedark earned 300 total points
ID: 5955568
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
   RS.AddNew
   For fc = 1 To FieldCount
       RS(fldNames(fc)) = flds(fc)
   Next fc
   RS.Update
Loop

Close wlfn
RS.Close
DB.Close

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
Do
   '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
           Do
               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
           Loop
                   
           
           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
           Else
               ReturnArray(FieldCount) = ""
           End If
       Else
           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
                   Err.Clear
                   DV = DateValue(ReturnArray(FieldCount))
                   If Err.Number = 0 Then
                       ReturnArray(FieldCount) = DV
                   Else
                       InvalidFormat = True
                   End If
                   On Error GoTo 0
               End If
           Else
               ' must be a number
               ReturnTypes(FieldCount) = "N"
               If ConvertNumerics Then
                   On Error Resume Next
                   Err.Clear
                   NV = Val(ReturnArray(FieldCount))
                   If Err.Number = 0 Then
                       ReturnArray(FieldCount) = NV
                   Else
                       InvalidFormat = True
                   End If
                   On Error GoTo 0
               End If
           End If
       End If
   End If
   LPos = CPos
Loop

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

Exit Sub

AddFieldCount:

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"

Return


End Sub
0
 
LVL 17

Expert Comment

by:inthedark
ID: 5957030
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?

0
 

Author Comment

by:laysee
ID: 5964414
Hi,

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!

tks.

laysee
0

Featured Post

What does it mean to be "Always On"?

Is your cloud always on? With an Always On cloud you won't have to worry about downtime for maintenance or software application code updates, ensuring that your bottom line isn't affected.

Question has a verified solution.

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

I’ve seen a number of people looking for examples of how to access web services from VB6.  I’ve been using a test harness I built in VB6 (using many resources I found online) that I use for small projects to work out how to communicate with web serv…
Introduction In a recent article (http://www.experts-exchange.com/A_7811-A-Better-Concatenate-Function.html) for the Excel community, I showed an improved version of the Excel Concatenate() function.  While writing that article I realized that no o…
As developers, we are not limited to the functions provided by the VBA language. In addition, we can call the functions that are part of the Windows operating system. These functions are part of the Windows API (Application Programming Interface). U…
This lesson covers basic error handling code in Microsoft Excel using VBA. This is the first lesson in a 3-part series that uses code to loop through an Excel spreadsheet in VBA and then fix errors, taking advantage of error handling code. This l…
Suggested Courses

721 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