Upload Data using Microsoft Excel in Visual Basic 6.0 (MySql Database)

 Author: Ken V.


Option Explicit

Dim pricelistObj As PriceListObjectClass

Dim xlconn As ADODB.Connection
Dim xlrs As ADODB.Recordset

Dim rs As New Recordset

Dim gridToUpload As MSHFlexGrid

Dim col As Integer
Dim row As Integer

Public Sub initXL(xlApp As String)
    Set xlconn = New ADODB.Connection
    Set xlrs = New ADODB.Recordset
   
    With xlconn
        .Provider = "MSDASQL"
        .connectionString = "Driver={Microsoft Excel Driver (*.xls)};" & _
        "DBQ=" & xlApp & "; ReadOnly=False;"
        On Error GoTo errHandler
        .Open
    End With
   
    Exit Sub
errHandler:
    MsgBox Err.Description
End Sub

Public Sub populateUPLGrid(xlApp As String, grid As MSHFlexGrid)
    initXL (xlApp)
    grid.Clear
   
    With xlrs
        If .State = adStateClosed Then
            .Open "select * from [sheet1$]", xlconn, adOpenKeyset, adLockOptimistic
        End If
       
        Set grid.DataSource = xlrs
    
    End With
   
   
    Set gridToUpload = grid
End Sub
Public Sub updloadData(progress As ProgressBar, cmdUpload As CommandButton)
   
    Dim delay1 As Integer
    Dim delay2 As Integer
      
    progress.value = 0
   
    row = 1
   
    With gridToUpload
        cmdUpload.Enabled = False
        Do While row < .Rows
                //here I upload a list of price list into mysql database using the vb6 interface.
            setValues (row)
            Call RevisedTransModule.addPricelist(pricelistObj)
            For delay1 = 0 To 10000
                For delay2 = 0 To 1000
                Next delay2
            Next delay1
            progress.value = ((row + 1) / gridToUpload.Rows) * 100
           
            row = row + 1
        Loop
        cmdUpload.Enabled = True
    End With
    MsgBox "Data has been successfully uploaded!"
End Sub
Public Sub setValues(rowCount As Integer)
    Dim colName As String

    Set pricelistObj = New PriceListObjectClass

    With gridToUpload
        col = 0
        Do While col < (.Cols)
            colName = Trim(.TextMatrix(0, col))
            Select Case colName
                Case "Data1"
                    pricelistObj.letData1 = .TextMatrix(rowCount, col)
                Case "Data2"
                    pricelistObj.letData2 = .TextMatrix(rowCount, col)
                Case "Data3"
                    pricelistObj.letData3 = .TextMatrix(rowCount, col)
                Case "Data4"
                    pricelistObj.letData4 = .TextMatrix(rowCount, col)
                Case "Data5"
                    pricelistObj.letData5 = .TextMatrix(rowCount, col)
                Case "Data6"
                    pricelistObj.letData6 = .TextMatrix(rowCount, col)
                Case "Data7"
                    If .TextMatrix(rowCount, col) <> "" Then
                        pricelistObj.letData7 = .TextMatrix(rowCount, col)
                    End If
            End Select
            col = col + 1
        Loop
    End With
End Sub

Public Sub fromOjbToGrid(r_index As Integer, grid As MSHFlexGrid)
    Dim colName As String
   
    With grid
        col = 0
        Do While col < (.Cols)
            colName = Trim(.TextMatrix(0, col))
            Select Case colData
                Case "Data1"
                    .TextMatrix(r_index, col) = pricelistObj.getData1
                Case "Data2"
                    .TextMatrix(r_index, col) = pricelistObj.getData2
                Case "Data3"
                    .TextMatrix(r_index, col) = pricelistObj.getData3
                Case "Data4"
                    .TextMatrix(r_index, col) = pricelistObj.getData4
                Case "Data5"
                    .TextMatrix(r_index, col) = pricelistObj.getData5
                Case "Data6"
                    .TextMatrix(r_index, col) = pricelistObj.getData6
                Case "Data7"
                    .TextMatrix(r_index, col) = pricelistObj.getData7
            End Select
            col = col + 1
        Loop
    End With
End Sub
//here I make the Upload history, simple way in checking the uploaded data.
Public Sub checkUploaded(grid As MSHFlexGrid)
    grid.Clear
   
    Dim gridIndex As Integer
   
    gridIndex = 1
   
    grid.Rows = gridToUpload.Rows
    grid.Cols = gridToUpload.Cols
   
    For col = 0 To gridToUpload.Cols - 1
        grid.TextMatrix(0, col) = gridToUpload.TextMatrix(0, col)
    Next
   
   
   
    With gridToUpload
        row = 1
        Do While row < .Rows
            setValues (row)
            On Error Resume Next
            rs.Open "select * from DataTable where Data1='" & pricelistObj.getData1 & "' and Data2='" & pricelistObj.Data2 & "' and Data3='" & pricelistObj.getData3 & "'", conn, adOpenKeyset, adLockOptimistic
           
            If Not rs.EOF Then
                Set pricelistObj = New PriceListObjectClass
                pricelistObj.letData1 = rs!Data1                pricelistObj.letData2 = rs!Data2                pricelistObj.letdata3 = rs!Data3
                pricelistObj.letdata4 = rs!Data4
                pricelistObj.letData5 = rs!Data5
                pricelistObj.letData6 = rs!Data6
                pricelistObj.letData7 = rs!Data7
               
                Call fromOjbToGrid(gridIndex, grid)
                gridIndex = gridIndex + 1
            End If
            rs.Close
            row = row + 1
        Loop
    End With
End Sub

Public Sub checkRejected(grid As MSHFlexGrid)
    grid.Clear
   
    Dim gridIndex As Integer
   
    gridIndex = 1
   
    grid.Rows = gridToUpload.Rows
    grid.Cols = gridToUpload.Cols
   
    For col = 0 To gridToUpload.Cols - 1
        grid.TextMatrix(0, col) = gridToUpload.TextMatrix(0, col)
    Next
   
    With gridToUpload
        row = 1
        Do While row < .Rows
            setValues (row)
            On Error Resume Next
            rs.Open "select * from DataTable where Data1='" & pricelistObj.getData1 & "' and Data2='" & pricelistObj.getData2 & "' and Data3='" & pricelistObj.getData3 & "'", conn, adOpenKeyset, adLockOptimistic
           
            If rs.EOF Then
                Call fromOjbToGrid(gridIndex, grid)
                gridIndex = gridIndex + 1
            End If
            rs.Close
            row = row + 1
        Loop
    End With
End Sub