Use ADO to Insert Data From CSV Into Excel

Database Search

If you can't find the information using the categories below, post a question over in our WinBatch Tech Support Forum.

TechHome

ADO DAO

	ADSI LDAP CDO
	Samples from Users

Can't find the information you are looking for here? Then leave a message over on our WinBatch Tech Support Forum.

Use ADO to Insert Data From CSV Into Excel

; Winbatch - Using ADO for selection and insertion of
;            data from a csv file into specific Excel Worksheets
; 
; Stan Littlefield - January 17, 2005
;
; The script ends with the workbook open for inspection but 
; it does not save anything.
; Uses the Microsoft Text Driver rather than Jet 4.0 OLEDB
; as using the driver directly may be a little faster for large files
;///////////////////////////////////////////////////////////////////////
gosub udfs
IntControl(73,1,0,0,0) 
path = dirscript()
cTxt = StrCat(path,"emm.csv")
If ! FileExist(cTxt) Then gosub createtxt

oXL=0
oXL = CreateObject("Excel.Application")
If oXL == 0 Then Exit
oXL.Visible          = 1  
oXL.ScreenUpdating   = 1   
oXL.UserControl      = 1
oXL.DisplayAlerts    = 0
oXL.WorkBooks.Add()
n = oXL.ActiveWorkbook.Worksheets.Count
If n<3
   While n<3
      oXL.ActiveWorkbook.Worksheets.Add()
      n = oXL.ActiveWorkbook.Worksheets.Count
   EndWhile
Endif

oWS = oXL.ActiveWorkbook.Worksheets(3)
oWS.Activate()
oWS.Name = "Miney"
oWS = oXL.ActiveWorkbook.Worksheets(2)
oWS.Activate()
oWS.Name = "Meeny"
oWS = oXL.ActiveWorkbook.Worksheets(1)
oWS.Activate()
oWS.Name = "Eeny"

cSQL = "SELECT * FROM emm.csv WHERE Fld1='Eeny';"
If ! GetTextFileData(cSQL, path, oXL.ActiveWorkbook.Worksheets(1), "A1", @True) Then goto failure

cSQL = "SELECT * FROM emm.csv WHERE Fld1='Meeny';"
If ! GetTextFileData(cSQL, path, oXL.ActiveWorkbook.Worksheets(2), "A1", @True) Then goto failure

cSQL = "SELECT * FROM emm.csv WHERE Fld1='Miney';"
If ! GetTextFileData(cSQL, path, oXL.ActiveWorkbook.Worksheets(3), "A1", @True) Then goto failure

goto end

:failure
display(2,"Data Insert Failure","Discontinuing Process")
oXL.Quit()

:end
oXL=0

Exit

:WBERRORHANDLER
oXL=0
ErrorProcessing(0,1,0)
Exit

:createtxt
cVar = StrCat("Fld1,Fld2,Fld3",@CRLF)
For i = 1 To 50
   cVar = StrCat( cVar,"Eeny,",Random(10000),",",Random(10000),@CRLF)
   cVar = StrCat( cVar,"Meeny,",Random(10000),",",Random(10000),@CRLF)
   cVar = StrCat( cVar,"Miney,",Random(10000),",",Random(10000),@CRLF)
Next

FilePut(cTxt,cVar)
Drop(cVar)

Return


:udfs
#DefineFunction GetTextFileData(cSQL, cFolder, oSheet, cRange, lHeaders)
; cSQL - Fully qualified SELECT Statement, includes full name of text or csv file
; cFolder - path where text file is located 
; oSheet - Worksheet (must exist) you want activated
; cRange - text string, i.e. A1, B36, where you want the recordset data placed
; lheaders - True/False - whether or not to include recordset column headings
; Mea Culpa, Mea Culpa, Mea Maxima Culpa - for using %substitution%

IntControl(73,1,0,0,0)
adStateOpen=1 
adOpenForwardOnly=0
adLockReadOnly=1
adCmdText=1

oConn = CreateObject("ADODB.Connection")
oRS = CreateObject("ADODB.Recordset")
oConn.Open("Driver={Microsoft Text Driver (*.txt; *.csv)};Dbq=%cFolder%;Extensions=asc,csv,tab,txt;")
n=0
While n<3
   If oConn.State <> adStateOpen 
      Timedelay(1)
      n=n+1
   Else
      Break
   Endif
Endwhile
If n>2
   oConn.Close()
   oConn=0
   Return(0)
Endif
oRS.Open(cSQL, oConn, adOpenForwardOnly, adLockReadOnly, adCmdText )
n=0
While n<3
   If oRS.State <> adStateOpen 
      Timedelay(1)
      n=n+1
   Else
      Break
   Endif
Endwhile
If n>2
   oRS=0
   oConn.Close()
   oConn=0
   Return(0)
Endif

If oRS.eof
   display(1,"Cannot Insert","Recordset Has No Rows")
   oRS.Close()
   oRS=0
   oConn.Close()
   oConn=0
   Return(0)
Endif
oSheet.Activate()
If lHeaders  ; include Recordset Column Names
   For f = 0 To oRS.Fields.Count - 1
      oSheet.Range("%cRange%").Offset(0, f).Formula = oRS.Fields(f).Name
   Next
Endif
oSheet.Range("%cRange%").Offset(1, 0).CopyFromRecordset(oRS)
; add additional code to format columns, save workbook etc...
oRS.Close()
oRS=0
oConn.Close()
oConn=0
Return(1)

:WBERRORHANDLER
IntControl(73,1,0,0,0)
ErrorProcessing(0,1,0)
Return(0)
#EndFunction


#DefineSubroutine ErrorProcessing(deleteIni,showerr,logfile)  
WbError = LastError()
WbTextcode = WbError
If WbError==1668||WbError==2669||WbError==3670
   ; 1668 ; "Minor user-defined error"
   ; 2669 ; "Moderate user-defined error"
   ; 3670 ; "Severe user-defined error"
   WbError = ItemExtract(1,IntControl(34,-1,0,0,0),":")
   WbTextcode = -1
EndIf
WbErrorString = IntControl(34,WbTextcode,0,0,0)
WbErrorDateTime = TimeYmdHms()
WbErrorFile = StrCat(DirWindows(0),"WWWBATCH.INI")
If deleteIni
   FileDelete(WbErrorFile)
   IniWritePvt(WbErrorDateTime,"CurrentScript",WbErrorHandlerFile      ,WbErrorFile)
   IniWritePvt(WbErrorDateTime,"ErrorValue"   ,WbError                 ,WbErrorFile)
   IniWritePvt(WbErrorDateTime,"ErrorString"  ,WbErrorString           ,WbErrorFile)
   IniWritePvt(WbErrorDateTime,"ScriptLine"   ,WbErrorHandlerLine      ,WbErrorFile)
   IniWritePvt(WbErrorDateTime,"ScriptOffset" ,WbErrorHandlerOffset    ,WbErrorFile)
   IniWritePvt(WbErrorDateTime,"VarAssignment",WbErrorHandlerAssignment,WbErrorFile)
   IniWritePvt(WbErrorDateTime,"VarInSegment" ,WbErrorInSegment,WbErrorFile)
   IniWritePvt("","","",WbErrorFile)
Endif  
WbErrorMsgText = StrCat(WbErrorDateTime,@CRLF)
WbErrorMsgText = StrCat(WbErrorMsgText,"Current Script: ",WbErrorHandlerFile,@CRLF)
WbErrorMsgText = StrCat(WbErrorMsgText,"Error# [",WbError,"]",@CRLF)
WbErrorMsgText = StrCat(WbErrorMsgText,"Error Text: ",wberrortextstring,@CRLF)
WbErrorMsgText = StrCat(WbErrorMsgText,"[Extended Information] ",wberroradditionalinfo,@CRLF,@CRLF)
WbErrorMsgText = StrCat(WbErrorMsgText,"On Line:",@CRLF,WbErrorHandlerLine,@CRLF)
WbErrorMsgText = StrCat(WbErrorMsgText,"Offset: ",WbErrorHandlerOffset,@CRLF)
If (WbErrorHandlerAssignment>"") Then %WbErrorHandlerAssignment% = "UNKNOWN"
WbErrorMsgText = StrCat(WbErrorMsgText,"Assignment/Variable: ",WbErrorHandlerAssignment,@CRLF)
If (WbErrorInSegment>"") Then WbErrorMsgText = StrCat(WbErrorMsgText,"In UDF/UDS: ",WbErrorInSegment,@CRLF)
If logfile
   cSep = StrCat(StrFill("=",50),@CRLF)
   cLogFile = StrCat(dirscript(),"log.err")
   If ! FileExist(cLogFile) Then FilePut(cLogFile,StrCat("Error Log",@CRLF,cSep))
   FilePut(cLogFile,StrCat(FileGet(cLogFile),WbErrorMsgText,cSep))
Endif
If showerr Then Message("wbErrorHandler",WbErrorMsgText)
Return(1)
#EndSubroutine

Return
;//////////////////////////////////////////////////////////////////////////////////////

Article ID:   W17116

File Created: 2007:07:03:14:28:22

Last Updated: 2007:07:03:14:28:22