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 <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