VBA/VBScript to Load Excel Files In A Folder Into SQL Server 2000 table

[Teaser]

Hi. I am very new to VBA and the task in hand is a tough one to start with. Basically I have requirement of code I can run using Active X in DTS to load data that sits in excel files in a certain folder location into an sql server 2000 table. All the files will be of the same format and will be on the first sheet. I know I need a connection to the sql server database, a connection string to Excel Application, something to identify what table the data is to go in, an array and loop to hold the file names and load one file at a time. However I just do not know how to put it all together. I am in desperate need of this code so any help would be very appreciated.

[Teaser]

Thanks Jinnantonnix.. it is not a one off task. I need to automate this process. I can get a very simple code to work in access which as you say can buy me some time but this requirement is part of a very large project where there are a lot of depencies on jobs so a coded solution that can run in an active x scipt in sql 2000 is required.

[pcstru]

I'd do this with one workbook in which the files to process are listed in a sheet, lets say Sheet1 in Column A. So the driving code might be something like :

 

Foreach MyCell in worksheets("Sheet1").Range("A1:A100")
   call ReadWkBk( MyCell.Value )
next

 

(or you might scan files for xls in a directory etc)

 

To load the workbooks and squirt the data at the database (ooerr missus) :

 

sub ReadWkBk( sFile as string )

  Dim sServer, sDBName As String
  sServer = "TheServer"
  sDBName = "TheDatabase"

  Dim ConnectionString As String
  ConnectionString = _
        "Provider=SQLOLEDB;" & _
        "Data Source=" + sServer + ";" & _
        "Initial Catalog=" + sDBName + ";" & _
        "Integrated Security=SSPI"

  ' Connection assumes you have permission to connect to the named database as part of an AD
  ' group. Early binding assumes you have references set to the appropriate active X lib
  Set connection = CreateObject("ADODB.Connection")
  connection.Open ConnectionString

  dim wbIn as Workbook
  Set wbIn = Workbooks.Open(sFile)

  dim rSheet as Range
  Set rSheet = wbIn.Worksheets("Sheet1").Range("A1:AZ10000")
  
  Dim iRow as integer
  iRow = 1
  Dim sSQL as string

  ' Process rows while there is a value in the first column 
  While rSheet(iRow,1).value <> ""
     ' Build a SQL command
     sSQL = "INSERT INTO </pre><table> (Field1,Field2,Field3 ... etc) VALUES ( " +_
             rSheet(iRow,1).value + "," + _
             rSheet(iRow,2).value + "," + _
             rSheet(iRow,3).value + "," + _
                  ... etc + _
             " )"
     ' Excecute the SQL
     Set Recordset = connection.Execute(sSQL, recs, CommandTypeEnum.adCmdText)
     ' Move to next row
     iRow = iRow + 1
  wend

  connection.close
  wbIn.Close
  
end sub
</

 

Or summat very much like that.

[Teaser]

Many Thanks pcstru .. thats a good place to start.. however I still need to means to scan the folder for the xls files and rather than doing a transformation of data by column, is there no means to say select * from the xl file and load into table XYZ as the structure for the files and the table are locked?

[pcstru]

Scanning folders can be done with the dir function.

 

Sub FScan

  sPath = "c:\test\"
  sFile = dir(sPath + "*.xls")
  while sFile <> ""
     sFile = dir()
     ProcessFile(sPath + sFile)
  wend

end sub

 

It's a bit trickier if you need to traverse through folders, where you are probably better off with the Application.FileSearch object example here.

 

I'm not sure what you mean by the files and table structures are "locked". I'd kind of assumed the table structure would be fixed (!) as are the xl files (in that they will be in a certain form) - you need to name the fields and put the appropriate columns into the correct fields. Even if you could do a select on the xls file straight in to a SQL database (and I'm not aware you can), you presumably still have to get the correct information into the correct fields of the correct table??

[Teaser]

thanks guys..

 

i had some luck.. i used visual studio to put together my code and EVENTUALLY got it to work.. See code below.

 

However, when I put this into an active x script in a DTS in SQL Server 2000 it dont work. Not sure why but it does not like me declaring the objects.. for example the first error i get is on line 2. When i comment out the line after dir and leave it as Dim Dir then the error moves onto the next line.. i have tried declaring/setting the objects before the function and latter in the function but i get all sorts of errors.. is there something fundamentally wrong with the code? it does work though in visual studio.. PLEASE HELP

 

Function Main()

Dim Dir As New System.IO.DirectoryInfo("D:\Baz\workflow")

Dim fil As System.IO.FileInfo

Dim conn As OleDbConnection

Dim sqlConn As New SqlConnection("Server=GBU0033\PROD;Database=Ad hocs;uid=stock_sales;password=letmein;connect timeout=100;Integrated Security=SSPI;")

Dim sqlcmd As New SqlCommand("", sqlConn)

Dim cmd As OleDbCommand

Dim drSheet As OleDbDataReader

 

sqlConn.Open()

 

sqlcmd.ExecuteNonQuery()

 

For Each fil In dir.GetFiles("*.xls")

 

conn = New OleDbConnection("Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & fil.FullName & ";Extended Properties='Excel 8.0;HDR=Yes;IMEX=1';")

cmd = New OleDbCommand("SELECT * FROM [sheet1$]", conn)

 

conn.Open()

 

drSheet = cmd.ExecuteReader

 

Do While drSheet.Read()

 

sqlcmd.CommandText = "INSERT INTO dbo.tblbaztest VALUES (" & drSheet(0) & ",'" & drSheet(1) & "')"

sqlcmd.ExecuteNonQuery()

 

Loop

 

conn.Close()

conn = Nothing

cmd = Nothing

drSheet = Nothing

 

Next

 

sqlConn.Close()

sqlConn = Nothing

sqlcmd = Nothing

 

Main = DTSTaskExecResult_Success

 

End Function

[srochford]

You've written it in VB.Net but SQL 2000 has no way of working with this - I seem to remember it's pretty much VB6

 

Does it have to go in DTS? Can't it just run as a standalone program outside the server?

[Teaser]

I was struggling with VB Script so reverted to what I know but only latter found out sql 2000 does not support .Net.

 

Unfortunately it does have to be in a DTS as this is just a small part of a very big process.

 

Any help will be much appreciated.

[Teaser]

some progress...

 

The code below is almost there... i have a problem with the insert statement strSQL = "INSERT INTO dbo.tblbaztest VALUES (" & arrXlData(0,x) & ",'" & arrXlData(0,x) & "')". With some debug code i noticed it was picking up the same value twice, once without any quotes and once with single quotes. So i did this "INSERT INTO dbo.tblbaztest VALUES ('" & arrXlData(0,x) & "')" . This works if the xls file has one column and the table has one column. However I need to load numerous columns. So in the code below I do not have a multidimentional array because with .Net "INSERT INTO dbo.tblbaztest VALUES (" & drSheet(0) & ",'" & drSheet(1) & "')" appears to work without a multidimentional array. Any ideas how to get this to work in my code below?

 

 

 

 

 

Function Main()

 

'---------------------------------------------------------------------------

' set page variables and constants

'---------------------------------------------------------------------------

 

'---- Constants required for database access ----

Const adOpenForwardOnly = 0 '---- CursorTypeEnum

Const adLockReadOnly = 1 '---- LockTypeEnum

Const adCmdText = &H0001 '---- CommandTypeEnum

 

'---- Page Variables ----

dim dbSqlConnect, strSqlConnection, strSQL, objSqlCmd

dim dbXlConnect, strXlSQL, rstXlResults, arrXlData

dim objFSO, objStartFolder, objFolder, objFile

 

objStartFolder = "D:\Baz\workflow"

strXlSQL = "SELECT * FROM [sheet1$]"

strSqlConnection = "Provider=sqloledb; Data Source=GBU0033\PROD; Initial Catalog=Ad hocs; User Id=stock_sales; Password=letmein;"

 

'---------------------------------------------------------------------------

' do the fun stuff

'---------------------------------------------------------------------------

 

Set objFSO = CreateObject("Scripting.FileSystemObject")

 

'---- check the folder exists ----

If Not objFSO.FolderExists(objStartFolder) Then

Wscript.Echo "Folder does not exist."

Else

Set objFolder = objFSO.GetFolder(objStartFolder)

 

'---- loop through all files and process xls files ----

For each objFile In objFolder.Files

If objFSO.GetExtensionName(objFile) = "xls" Then

'Wscript.Echo "Processing file: " & objFile.Path

 

'---------------------------------------------------------------------------

'---- connect to spreadsheet and grab all the data ----

'---------------------------------------------------------------------------

 

Set dbXlConnect = CreateObject("ADODB.Connection")

dbXlConnect.Open = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & objFile.Path & ";Extended Properties=""Excel 8.0;HDR=Yes;"";"

 

Set rstXlResults = CreateObject("ADODB.Recordset")

rstXlResults.Open strXlSQL, dbXlConnect, adOpenForwardOnly, adLockReadOnly, adCmdText

 

if rstXlResults.bof and rstXlResults.eof then

Wscript.Echo "There was no data in this spreadsheet"

else

'grab everything into an array to work with, quicker since we don't

'keep connection open and have to keep going back for data

arrXlData = rstXlResults.GetRows

end if

 

'---- close results set ----

rstXlResults.Close

Set rstXlResults = Nothing

 

' ---- close excel connection ----

dbXlConnect.Close

Set dbXlConnect = Nothing

 

'---------------------------------------------------------------------------

'---- import all the data into the SQL Server DB ----

'---------------------------------------------------------------------------

 

if isarray(arrXlData) then

 

Set dbSqlConnect = CreateObject("ADODB.Connection")

dbSqlConnect.Open strSqlConnection

 

'loop data and insert into db

for x=0 to ubound(arrXlData,2)

 

strSQL = "INSERT INTO dbo.tblbaztest VALUES (" & arrXlData(0,x) & ",'" & arrXlData(0,x) & "')"

 

Set objSqlCmd = CreateObject("ADODB.Command")

objSqlCmd.ActiveConnection = dbSqlConnect

objSqlCmd.CommandType = adCmdText

objSqlCmd.CommandText = strSQL

objSqlCmd.Execute

Set objSqlCmd = Nothing

 

next

 

set dbSqlConnect = nothing

set arrXlData = nothing

 

end if

 

End If

Next

 

End If

 

set objFSO = Nothing

 

End Function