frmmain.frm

Converting CSV Files to SQL using VB6

    
        MsgBox "Please provide the field name and datatype to add a field to the grid."
        
    End If

End Sub

Private Sub btnRemoveField_Click()

    If MSFGFields.Rows <= 1 Then Exit Sub
    If MSFGFields.RowSel < 1 Then Exit Sub
    
    If MSFGFields.Rows = 2 And MSFGFields.RowSel = 1 Then
        MSFGFields.Rows = 1
    Else
        MSFGFields.RemoveItem MSFGFields.RowSel
    End If
    
    lblSelectedField.Caption = "No Selected Field."

End Sub

Private Sub cmdLocate_Click()

    On Error GoTo ErrHandler
    
        CommonDialog1.DialogTitle = "Find Source File"
        CommonDialog1.InitDir = App.Path
        CommonDialog1.CancelError = True
        CommonDialog1.ShowOpen
                
        
        Me.txtImportFile = CommonDialog1.FileName
        Me.txtExportFile = Left(Me.txtImportFile, Len(Me.txtImportFile) - 3) & "sql"
                
        

ErrHandler:
End Sub

Private Sub cmdOk_Click()

    Dim i As Integer
    Dim DataTypes() As String
    Dim FieldNames() As String
    Dim ImFile As Scripting.TextStream
    Dim ExFile As Scripting.TextStream
    Dim ImLine() As String
    Dim SQL As String
    Dim Schema As String
        
    On Error GoTo ErrHandler
    
    ' Has table name been supplied?
    If txtTableName.Text = "" Then
        MsgBox "A table name is needed.  Process Aborted."
        Exit Sub
    End If
    
    ' Import file supplied?
    If txtImportFile.Text = "" Then
        MsgBox "You need to locate a file to import."
        Exit Sub
    End If
    
    ' Make sure some field names have been declared.
    If MSFGFields.Rows < 2 Then
        MsgBox "You haven't added any column names.  Process Aborted."
        Exit Sub
    End If
    
    ' Open the import and export files.
    Set ImFile = fso.OpenTextFile(Me.txtImportFile, ForReading, False)
    Set ExFile = fso.OpenTextFile(Me.txtExportFile, ForWriting, True)
            
    
    ' Read field name from form
    FieldNames = GetFieldNames
    DataTypes = GetDataTypes
    
    ' Get Schema if applicable
    If txtUser.Text <> "" Then
        Schema = txtUser.Text & "."
    End If
        
    ' Loop around import file and export to another file.
    Do While Not ImFile.AtEndOfStream
    
        ImLine = Split(ImFile.ReadLine, "|")
        
        ' Check that the number of columns equals the number of fields
        ' specified by the user.
        If UBound(FieldNames) <> UBound(ImLine) Then
            MsgBox "Number of columns does not equal number of fields specified.  Process Aborted."
            ImFile.Close
            ExFile.Close
            Exit Sub
        End If
        
        SQL = "INSERT into " & Schema & Me.txtTableName & " ("
        
        ' Repeat for each field
        ' Enter the field names
        For i = 0 To UBound(FieldNames)
                    
            SQL = SQL & FieldNames(i)
            
            ' don't comma on last field
            If i < UBound(ImLine) Then
            
                SQL = SQL & ","
            
            End If
            
        
        Next
        
        ' Add closing braket and start the values bracket.
        SQL = SQL & ") VALUES ("
        
        ' Loop around and put values in.
        '  Trickier as we have to format each field depending on the
        '  field data type.
        For i = 0 To UBound(ImLine)
                        
            ' Add Data
            SQL = SQL & FormatData(ImLine(i), DataTypes(i))
            
            ' don't put comma on the end
            If i < UBound(ImLine) Then
                
                SQL = SQL & ","
            
            End If
                    
        
        Next
        
        ' Close Bracket
        SQL = SQL & ");" & vbCrLf
        
        ' Add line to export file
        ExFile.WriteLine SQL
    
    Loop
        
    ImFile.Close
    ExFile.Close
    
    MsgBox "Process Complete!"
        
    Exit Sub
    
ErrHandler:
MsgBox "Error occurred."
End Sub


Private Function GetFieldNames() As String()

    
    Dim FieldNames As String
    Dim i As Integer
    Dim GridRows As Integer
    
    GridRows = MSFGFields.Rows - 1
        
    ' Rotate through grid and get field names
    For i = 1 To GridRows
        
        FieldNames = FieldNames & MSFGFields.TextMatrix(i, 0)
        
        If i <> GridRows Then
            FieldNames = FieldNames & ","
        End If
        
    Next
    
    GetFieldNames = Split(FieldNames, ",")

End Function


Private Function GetDataTypes() As String()

    Dim DataTypes As String
    Dim i As Integer
    Dim GridRows As Integer
    
    GridRows = MSFGFields.Rows - 1
        
    ' Rotate through grid and get DataTypes
    For i = 1 To GridRows
        
        DataTypes = DataTypes & MSFGFields.TextMatrix(i, 1)
        
        If i <> GridRows Then
            DataTypes = DataTypes & ","
        End If
        
    Next
    
    GetDataTypes = Split(DataTypes, ",")

End Function

Private Function FormatData(Data As String, DataType As String) As String

    
    Select Case LCase(DataType)
    
        
        Case "number"
        ' send back as is with any quotes sorted.
        FormatData = Replace(Trim(Data), "'", "''")
        
        Case "varchar2"
        ' send back with quotes
        FormatData = "'" & Trim(Data) & "'"
        
        Case "date"
        ' send back date formatted
        FormatData = " TO_DATE('" & Trim(Data) & "','DD/MM/YY HH24:MI:SS') "
            
        Case Else
        MsgBox "Don't recognise data type.  You will need to revise or modify the code for this datatype.  Process cancelled."
        End
            
            
    End Select


End Function



Private Sub Form_Load()

    Set fso = New Scripting.FileSystemObject
        
    With MSFGFields
        .Rows = 1
        .TextMatrix(0, 0) = "Field"
        .TextMatrix(0, 1) = "Datatype"
        .ColWidth(0) = 1750
        .ColWidth(1) = 1750
        
    End With
    
    With cboDataTypes
    
        .AddItem "NUMBER"
        .AddItem "VARCHAR2"
        .AddItem "DATE"
    
    End With
   
    
    
End Sub

Private Sub Form_Unload(Cancel As Integer)

    Set fso = Nothing
    
End Sub

Private Sub MSFGFields_Click()

    If MSFGFields.Rows <= 1 Then Exit Sub
    
    lblSelectedField.Caption = MSFGFields.TextMatrix(MSFGFields.RowSel, 0)

End Sub