VBAHELP

Private Sub lstUserWP_Click()
    iRow = lstUserWP.ListIndex
    txtDepartment.value = lstUserWP.List(iRow, 3)
    txtRegion.value = lstUserWP.List(iRow, 4)
    txtWorkProcess.value = lstUserWP.List(iRow, 1)
    txtDescription.value = lstUserWP.List(iRow, 2)
End Sub

Private Sub btnLoadDatatoServer_Click()
Dim fPath As String
'
'truncate table [MonikaDB].[dbo].[tblMaster]
'truncate table [MonikaDB].[dbo].[tblHRIS]
'truncate table [MonikaDB].[dbo].[tblCombined]

fPath1 = shtAdmin.[C46] & "\"
fPath = "D:\6. HRIS\HRIS_Monika Group\"

Debug.Print "Start Time  - " & Now()
lblWorkingStatus.Caption = " Working on tblMaster"
Call ImportDataFromExcelToSQLServer(fPath1 & "WP MasterData.xlsx", "Master Data_Work Processes$", "tblMaster")
lblWorkingStatus.Caption = "Working on tblHRIS"
Call ImportDataFromExcelToSQLServer(fPath & "1 HRIS_ Monika Alcobev.xlsx", "Monika Alcobev HRIS$", "tblHRIS") 'Monika Alcobev HRIS$
lblWorkingStatus.Caption = "Working on tblWorkProcess"
Call ImportDataFromExcelToSQLServer(fPath1 & "Work Process.xlsx", "WorkProcess$", "tblWorkProcess")
lblWorkingStatus.Caption = "Updating Combined  data table."
Call UpdateCombinedData
Debug.Print "End Time  - " & Now()
lblWorkingStatus.Caption = "Data Loaded Sucessfully !!!"
lblWorkingStatus.BackColor = 8454016
End Sub

Function ImportDataFromExcelToSQLServer(xlFilePath As String, xlSheetName As String, Optional sqlTableName As String, Optional delolddata As Boolean)
'Function ImportDataFromExcelToSQLServer()
    Dim xlCn As Object
    Dim xlRs As Object
    Dim cmd As Object
    Dim connectionString As String
    Dim tableName As String
    Dim columnNames As String
    Dim rowValues As String
    Dim batchSize As Integer
    Dim lastCol As Integer
    Dim lastRow As Long
    Dim rCount As Integer
    Dim eRow As Integer
    
       
    ' Define Connection String for Excel
    'connectionString = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & xlFilePath & ";Extended Properties='Excel 12.0 Xml;HDR=YES';"
    connectionString = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & xlFilePath & ";Extended Properties='Excel 12.0 Xml;HDR=YES';"
    
    ' Initialize ADODB Objects
    Set xlCn = CreateObject("ADODB.Connection")
    Set xlRs = CreateObject("ADODB.Recordset")
    xlCn.Open connectionString
    
    ' Retrieve Data from Excel
    sqlQuery = "SELECT * FROM [" & xlSheetName & "]"
    If sqlTableName = "" Then sqlTableName = xlSheetName  ' Memory free to use xlsheetname
    xlRs.Open sqlQuery, xlCn, 1, 1 ' adOpenKeyset and adLockReadOnly
    
    If xlRs.EOF Then
        MsgBox "No data found in the Excel file!", vbExclamation
        GoTo endFunction
    End If


    ' Initialize batch processing
    batchSize = 100
    lastCol = xlRs.Fields.Count - 1
    lastRow = xlRs.recordcount
    rCount = 1
    eRow = 0
'    tableName = "tblMaster"

    xlRs.MoveFirst

    'Open SQL Server Connection
    If cnopen(1) = False Then GoTo endFunction
    
    
'    sqlQuery = "Select * from '" & sqlTableName & "' "
'    If rsOpen(1) = False Then GoTo endFunction
'    If rs.recordCount > 1 Then
    sqlQuery = " SP_TruncateTable " & sqlTableName & " "
    If rsOpen(4) = False Then GoTo endFunction
    
    Set cmd = CreateObject("ADODB.Command")
    cmd.ActiveConnection = cn

    'Loop through the Excel data and insert in batches
    Do While Not xlRs.EOF
        DoEvents
        eRow = Application.Min(rCount + batchSize - 1, lastRow)
        sqlQuery = "INSERT INTO " & sqlTableName & " ("

        'Build Column Names
        For j = 0 To lastCol
            sqlQuery = sqlQuery & "[" & xlRs.Fields(j).Name & "]"
            If j < lastCol Then sqlQuery = sqlQuery & ", "
        Next
        sqlQuery = sqlQuery & ") VALUES "

        'Build Row Values
        For i = rCount To eRow
            DoEvents
            rowValues = "("
            For j = 0 To lastCol
                DoEvents
                If j > lastCol Then ' Just breaker only
                    GoTo endFunction
                End If
                On Error Resume Next
'                Debug.Print xlRs.Fields(j).value
                If IsNull(xlRs.Fields(j).value) Then
                    If IsNull(xlRs.Fields("EMployee_Name").value) Then
                         xlRs.MoveNext
                         If IsNull(xlRs.Fields("EMployee_Name").value) Then
                            GoTo endFunction
                         End If
                    End If
                    rowValues = rowValues & "NULL"
                ElseIf TypeName(xlRs.Fields(j).value) = "Error" Then
                    rowValues = rowValues & "NULL"
                Else
                 rowValues = rowValues & "'" & Replace(xlRs.Fields(j).value, "'", "''") & "'"
                End If
            
                On Error GoTo 0
                If j < lastCol Then rowValues = rowValues & ","
         
            Next
            rowValues = rowValues & "),"
            sqlQuery = sqlQuery & rowValues
            xlRs.MoveNext
            rCount = rCount + 1
           
        Next
        sqlQuery = Left(sqlQuery, Len(sqlQuery) - 1) & ";"
        Debug.Print sqlQuery
        cmd.CommandText = sqlQuery
        cmd.CommandType = 1
        cmd.Execute
    Loop

endFunction:
    On Error Resume Next
    xlRs.Close
    xlCn.Close
    Set xlRs = Nothing
    Set xlCn = Nothing
    rsclose
    cnclose
End Function