VBA - import spreadsheet to database

import-spreadsheet-to-database.vba

Const strDbConn As String = "server=myServerName;Database=myDatabaseName;Trusted_Connection=Yes;Driver={ODBC Driver 17 for SQL Server}"

Public Function ImportData(sheet As String)
     
    Dim i As Long
    Dim strSQL As String
    Dim totalRows As Long
   
    totalRows = HowManyRows(sheet)
    strInsertHeader = GetInsertHeader()
    
    Dim strIndividualRows As String
    strIndividualRows = ""
   
    For i = 2 To totalRows
   
        strIndividualRows = strIndividualRows & getSQLForSingleRow(sheet, i)
       
       ' add comma at the end no matter what; remove last one after
       strIndividualRows = strIndividualRows & ","
      
       'Worksheets("Instructions").Range("I2").FormulaR1C1 = "Rows read in: " & i
       
       ' insert into the database before it gets too big
        If (i Mod 500) = 0 Then
              
            strSQL = strInsertHeader & " VALUES " & strIndividualRows
            strSQL = RemoveLastCharacterIfComma(strSQL)
           
            Call RunSQL(strDbConn, strSQL)
 
            strIndividualRows = ""
           
            'Debug.Print "in the middle of importing " & i
   
        End If
       
    Next
   
' insert in the last batch, but only if there's data
If strIndividualRows <> "" Then
    strSQL = strInsertHeader & " VALUES " & strIndividualRows
    strSQL = RemoveLastCharacterIfComma(strSQL)
    
    Call RunSQL(strDbConn, strSQL)
End If

    strIndividualRows = ""
    'Debug.Print "last row " & i
   
        
    Range("A1").Select
 
    ' Complete: clear out the status
   ' Worksheets("Instructions").Range("I1").Formula2R1C1 = ""
   ' Worksheets("Instructions").Range("I2").Formula2R1C1 = ""
    
    'MsgBox sheet + " data imported"
 
End Function

Public Sub autoImport()

    ' First delete existing data
    Dim strSQL As String
    strSQL = "DELETE FROM myTableName" ' Could potentially TRUNCATE instead
    Call RunSQL(strDbConn, strSQL)
    
    
    ' Import the new data
    Call ImportData("tabWithData") ' Be sure to pass in the name of your worksheet, or get it dynamically
        
        
    ' Indicate when the data was updated; I'm using a "utility" table
    Dim theDate As String
    theDate = InputBox("Enter date that the data for", "Data as of", Format(Now, "m/d/yyyy"))
    strSQL = "UPDATE Utility SET value = '" & ReplaceSingleQuote(theDate) & "' WHERE description IN ('Last Updated,'Last Updated')"
    Call RunSQL(strDbConn, strSQL)
        
    Range("A1").Select
    
    MsgBox "Data has been imported"
 
End Sub
  
Public Function RunSQL(strDbConn As String, strSQL As String)
  
    Dim cnn As Object
    Dim rst As Object
   
    Set cnn = CreateObject("ADODB.Connection")
    cnn.Open strDbConn
    Set rst = CreateObject("ADODB.Recordset")
    
    rst.Open strSQL, cnn, 3, 1 '3 = Keyset, 1 = Pessimistic
   
    Set rst = Nothing
   
End Function

Public Function GetInsertHeader() As String

   Dim strHeader  As String
    strHeader = ""
    strHeader = strHeader & " INSERT INTO myTableName ("
    strHeader = strHeader & " [field_one]"
    strHeader = strHeader & " ,[field_two]"
    strHeader = strHeader & " ,[field_three]"
    strHeader = strHeader & " )"
   
    GetInsertHeader = strHeader

End Function
 
Public Function getSQLForSingleRow(sheet As String, rowNumber As Long) As String
  
    ' Be sure to update any formatting; ex date or number
    fieldWithText = ReplaceSingleQuote(Worksheets(sheet).Range("A" & rowNumber).FormulaR1C1)
    fieldWithDate = Format(Worksheets(sheet).Range("B" & rowNumber).FormulaR1C1, "mm/dd/yyyy")
    fieldWithNumbers = CDbl(Nz(Worksheets(sheet).Range("C" & rowNumber).FormulaR1C1))
  
    
    Dim strSQL As String
 
    strSQL = " ("
   
    strSQL = strSQL & " '" & fieldWithText & "',"
    strSQL = strSQL & " '" & fieldWithDate & "',"
    strSQL = strSQL & " " & fieldWithNumbers & "" ' no quotes because it's numeric
   
    strSQL = strSQL & " ) "
 
    getSQLForSingleRow = strSQL
 
End Function

Public Function HowManyRows(sheetName As String) As Long

    'Find out how many row there are
    ' Assumes the first column does NOT have a blank in it
 
    Sheets(sheetName).Select
    Range("A1").Select

    Selection.End(xlDown).Select
   
    Dim totalRows As Long
    totalRows = ActiveCell.Row ' do NOT subtract one for the header
 
    HowManyRows = totalRows

End Function

Public Function ReplaceSingleQuote(str As String) As String
 
    If Len(Trim(str)) > 0 Then
        ReplaceSingleQuote = Replace(str, "'", "''")
    Else
        ReplaceSingleQuote = str
    End If
 
End Function
 
Public Function RemoveLastCharacterIfComma(str As String) As String
 
    str = Trim(str)
   
    If Right(str, 1) = "," Then
        RemoveLastCharacterIfComma = Left(str, Len(str) - 1)
    Else
        RemoveLastCharacterIfComma = str
    End If
    
End Function

Function Nz(value As String) As Double

    If IsNull(value) Or (value = "") Then
        Nz = 0
    Else
        Nz = value
    End If

End Function