How to import Excel to database by column name using VBA?

Question

Does anyone know the way to import Excel data in to SQL database by column name using VBA?

For example, I have an Excel file with 5 columns: column1, column2, column3, column 4, column 5. Position of these column are generated randomly I only want to import data of 3 columns: column1, column3, column5 in to SQL database using VBA.

Answer 1

You can use ADO connections.

You can open a connection to the target server, loop your data and then insert it to the target database. This can get you started: http://www.vbexplorer.com/VBExplorer/vb_feature/june2000/Database_Beginner_ADO_DAO.asp

Otherwise, depending on your target database, it may have some proprietary import tool - this will normally require you to export your excel to some format it recognizes.

For a full blown solution, you can consider using an ETL tool

Answer 2

So as you will see from the variable names this was meant for a lotus file however, i reused it for a csv. So the structure will be the same for your excel file. If you want just save it as CSV and happy days with this. I know it been 6 years so i guess you dont need this anymore but might help anyone else who comes across this.

    Dim LotusCn As Object
    Dim rsLotus As Object
    Dim strSql, CombFileName, GotoRange As String
    Dim rsLotusFiles As DAO.Recordset
    Dim rsDAO1 As DAO.Recordset
    Dim strName1 As String

    Set LotusCn = CreateObject("ADODB.Connection")
    Set rsLotus = CreateObject("ADODB.Recordset")

    strSql = "Provider=" & _ 'This is where the file is located
    CurrentProject.Connection.Provider & _
    ";Data Source=" & Directory & _
    ";Extended Properties='text;HDR=YES;FMT=Delimited'"

    LotusCn.Open strSql
    Dim fld1 As ADODB.Field

    strSql = "SELECT * FROM NUMBDATM.CSV" 'This is the file name and please open it
    rsLotus.Open strSql, LotusCn, adOpenFowardOnly, adLockReadOnly, adCmdText


    Set rsDAO1 = CurrentDb.OpenRecordset("NUMBDATM", _ 'This here is the table you 
    dbOpenTable, dbAppendOnly + dbFailOnError)          want to import into 

    Do Until rsLotus.EOF 'Here tell it what values you want from the excel Sheet
          RegNumber = rsLotus![Reg# Number]
          CompanyName = rsLotus![Company Name]
          SalesGrowth1 = rsLotus![Sales Growth % 1 ]
          FixedAssets1 = rsLotus![Fixed Assets 1 ]
          PeriodEnding1 = rsLotus![Period Ending 1 ]
          TotalSales1 = rsLotus![Total Sales 1 ]
          SalesGrowth2 = rsLotus![Sales Growth % 2 ]
          SalesGrowth3 = rsLotus![Sales Growth % 3 ]
          PreTaxProfit3 = rsLotus![Pretax Profit 3 ]
          PreTaxProfit2 = rsLotus![Pretax Profit 2 ]
          PreTaxProfit1 = rsLotus![Pretax Profit 1 ]
          PrProfitMarg = rsLotus![Pr#Profit Margin  % 1 ]
          Week1 = rsLotus![Weeks 1 ]
          Week2 = rsLotus![Weeks 2 ]
          Week3 = rsLotus![Weeks 3 ]
        rsDAO1.AddNew 'Here please add the values from above into the relevant table
            rsDAO1![Reg# Number] = RegNumber
            rsDAO1![Company Name] = CompanyName
            rsDAO1![Sales Growth % 1 ] = SalesGrowth1
            rsDAO1![Fixed Assets 1 ] = FixedAssets1
            rsDAO1![Period Ending 1 ] = PeriodEnding1
            rsDAO1![Total Sales 1] = TotalSales1
            rsDAO1![Sales Growth % 2 ] = SalesGrowth2
            rsDAO1![Sales Growth % 3 ] = SalesGrowth3
            rsDAO1![Pretax Profit 3 ] = PreTaxProfit3
            rsDAO1![Pretax Profit 2 ] = PreTaxProfit2
            rsDAO1![Pretax Profit 1 ] = PreTaxProfit1
            rsDAO1![Pr#Profit Margin  % 1 ] = PrProfitMarg
            rsDAO1![Weeks 1 ] = Week1
            rsDAO1![Weeks 2 ] = Week2
            rsDAO1![Weeks 3 ] = Week3
        rsDAO1.Update
        rsLotus.MoveNext
    Loop
    rsDAO1.Close
    Set rsDAO1 = Nothing
    rsLotus.Close
    Set rsLotus = Nothing
    LotusCn.Close

Answer 3

Protected Sub just_Click(sender As Object, e As EventArgs) Handles just.Click


Dim cnn As SqlConnection

Dim sql As String

Dim i, j As Integer

Dim xlApp As Excel.Application

Dim xlWorkBook As Excel.Workbook

Dim xlWorkSheet As Excel.Worksheet

Dim misValue As Object = System.Reflection.Missing.Value

xlApp = New Excel.ApplicationClass

xlWorkBook = xlApp.Workbooks.Add(misValue)

xlWorkSheet = xlWorkBook.Sheets("sheet1")

cnn = New SqlConnection("***your connection string***")

cnn.Open()

sql = "SELECT * FROM exceltable"

Dim dscmd As New SqlDataAdapter(sql, cnn)

Dim ds As New DataSet

dscmd.Fill(ds)

For j = 0 To ds.Tables(0).Columns.Count - 1

xlWorkSheet.Cells(i + 1, j + 1) = _

ds.Tables(0).Columns(j).ColumnName

Next

For i = 0 To ds.Tables(0).Rows.Count - 1


For j = 0 To ds.Tables(0).Columns.Count - 1

xlWorkSheet.Cells(i + 2, j + 1) = _

ds.Tables(0).Rows(i).Item(j)


Next

Next

xlWorkSheet.SaveAs("D:\pappy.xlsx")

xlWorkBook.Close()

xlApp.Quit()

cnn.Close()

End Sub