Home
Search
 
What's New
Index
Books
Links
Q & A
Newsletter
Banners
 
Feedback
Tip Jar
 
C# Helper...
 
XML RSS Feed
Follow VBHelper on Twitter
 
 
MSDN Visual Basic Community
 
 
 
 
 
TitleImport data in columns into a database
Keywordsdatabase, data, column, column data
CategoriesDatabase, Files and Directories
 
The data file looks like this:

    Rod       12345 Bug Place     Programmersville    AZ12345
    Anne      1247 Drover Ln      Somewhere           CA11111
    Bill      58967 East Lane N   Towne               HI22222
    Cindy     985 1st, Apt A      Burgers             ND33333

Fields on the program's form tell the program the names and positions of the columns.

The program uses the Line Input statement to read the data one line at a time. It uses the column names and positions to generate SQL INSERT statements similar to the following:

    INSERT INTO Addresses (Name, Address, City, State, Zip)
    VALUES ("Rod       ", "12345 Bug Place     ",
    "Programmersville    ", "AZ", "12345")

The program uses DAO to execute these statements to create the database records.

 
Private Sub cmdImport_Click()
Dim wks As Workspace
Dim db As Database
Dim fnum As Integer
Dim text_line As String
Dim sql_statement As String
Dim field_names() As String
Dim field_start() As Integer
Dim max_field As Integer
Dim i As Integer
Dim field_value As String
Dim pos1 As Integer
Dim pos2 As Integer
Dim line_length As Integer

    ' Get the field information.
    ReDim Preserve field_names(0 To txtField.UBound)
    ReDim Preserve field_start(0 To txtField.UBound + 1)
    For i = 0 To txtField.UBound
        field_names(i) = Trim$(txtField(i).Text)
        If Len(field_names(i)) = 0 Then Exit For
        field_start(i) = CInt(txtStart(i).Text)
    Next i
    max_field = i - 1
    field_start(i) = 10000

    ' Open the text file.
    fnum = FreeFile
    On Error GoTo NoTextFile
    Open txtTextFile.Text For Input As fnum

    ' Open the database.
    On Error GoTo NoDatabase
    Set wks = DBEngine.Workspaces(0)
    Set db = wks.OpenDatabase(txtDatabaseFile.Text)
    On Error GoTo 0

    ' Read the file and create records.
    Do While Not EOF(fnum)
        ' Read a text line.
        Line Input #fnum, text_line
        text_line = Trim$(text_line)
        line_length = Len(text_line)
        If Len(text_line) > 0 Then
            ' Build the field list.
            sql_statement = "INSERT INTO " & _
                txtTable.Text & " ("
            For i = 0 To max_field
                sql_statement = sql_statement & _
                    field_names(i)
                If i < max_field Then _
                    sql_statement = _
                        sql_statement & ", "
            Next i
            sql_statement = sql_statement & _
                ") VALUES ("

            ' Add the field values.
            For i = 0 To max_field
                pos1 = field_start(i)
                If pos1 > line_length Then
                    field_value = ""
                Else
                    pos2 = field_start(i + 1) - 1
                    If pos2 > line_length Then _
                        pos2 = line_length
                    field_value = Mid$(text_line, pos1, _
                        pos2 - pos1 + 1)
                End If
                sql_statement = sql_statement & _
                    """" & field_value & """"
                If i < max_field Then _
                    sql_statement = _
                        sql_statement & ", "
            Next i
            sql_statement = sql_statement & ")"
            
            ' Insert the record.
            On Error GoTo SQLError
            db.Execute sql_statement
            On Error GoTo 0
        End If
    Loop

    ' Close the file and database.
    Close fnum
    db.Close
    wks.Close
    MsgBox "Ok"
    Exit Sub

NoTextFile:
    MsgBox "Error opening text file."
    Exit Sub

NoDatabase:
    MsgBox "Error opening database."
    Close fnum
    Exit Sub
SQLError:
    MsgBox "Error executing SQL statement '" & _
        sql_statement & "'"
    Close fnum
    db.Close
    wks.Close
    Exit Sub
End Sub
 
 
Copyright © 1997-2010 Rocky Mountain Computer Consulting, Inc.   All rights reserved.
  Updated