SQL DTS Task recordset to Excel
I have a SQL dts task that runs query and pastes the data into an excel work book. The problem I have is that the server where the task will run does not have Excel installed. The vbscript is attached.
I need the vbscript that is attached to be re-written so that it does the same thing but doesnt need Excel installed on the server.
This site gives an option
<[login to view URL]>
## Deliverables
'vbscript
'Excel Constants
xlSolid = 1
xlAutomatic = -4105
xlThemeColorDark1 = 1
xlToRight = -4161
xlDown = -4121
xlDiagonalDown = 5
xlDiagonalUp = 6
xlEdgeLeft = 7
xlContinuous = 1
xlEdgeTop = 8
xlEdgeBottom = 9
xlEdgeRight = 10
xlInsideVertical = 11
xlInsideHorizontal = 12
xlThin = 2
xlToLeft = -4159
Function Main()
Dim AppExcel
Dim iRow
Dim iCol
Dim f
Dim r
Dim c
Set AppExcel = CreateObject("[login to view URL]")
Set rsDatos = DTSGlobalVariables("gdsSample").Value
[login to view URL] = False
Set objWB = [login to view URL]
iRow = 0
'To add the heading
For iCol = 0 To [login to view URL] - 1
[login to view URL](iRow + 1, iCol + 1).formula = Split( CStr(rsDatos(iCol).Name),"_")(0)
[login to view URL](iRow + 2, iCol + 1).formula = Split( CStr(rsDatos(iCol).Name),"_")(1)
Next
r=2
Do While Not [login to view URL]
r = r + 1
For f = 0 To [login to view URL] - 1
' On Error Resume Next
if not isnull([login to view URL](f).Value) then
'msgbox r
'msgbox f
[login to view URL](r, f+1).Formula = [login to view URL](f).Value
'msgbox [login to view URL](f).Value
end if
'On Error GoTo Errh
Next
'msgbox r
'msgbox [login to view URL](0).Value
[login to view URL]
Loop
'To copy the data into the excel
'[login to view URL](3, 1).CopyFromRecordset rsDatos
'msgbox [login to view URL]("atim_")
'To highlight the first 2 rows in grey.
[login to view URL]("A1:A2").Select
[login to view URL]([login to view URL], [login to view URL](xlToRight)).Select
With [login to view URL]
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.ColorIndex = 48
End With
'To make the first row bold.
[login to view URL]("1:1").Select
[login to view URL] = True
'To make the columns autofit.
[login to view URL]
[login to view URL]
'To put border for each cells
[login to view URL]("A1").Select
[login to view URL]([login to view URL], [login to view URL](xlToRight)).Select
[login to view URL]([login to view URL], [login to view URL](xlDown)).Select
[login to view URL](xlDiagonalDown).LineStyle = xlNone
[login to view URL](xlDiagonalUp).LineStyle = xlNone
With [login to view URL](xlEdgeLeft)
.LineStyle = xlContinuous
.ColorIndex = xlAutomatic
.Weight = xlThin
End With
With [login to view URL](xlEdgeTop)
.LineStyle = xlContinuous
.ColorIndex = xlAutomatic
.Weight = xlThin
End With
With [login to view URL](xlEdgeBottom)
.LineStyle = xlContinuous
.ColorIndex = xlAutomatic
.Weight = xlThin
End With
With [login to view URL](xlEdgeRight)
.LineStyle = xlContinuous
.ColorIndex = xlAutomatic
.Weight = xlThin
End With
With [login to view URL](xlInsideVertical)
.LineStyle = xlContinuous
.ColorIndex = xlAutomatic
.Weight = xlThin
End With
With [login to view URL](xlInsideHorizontal)
.LineStyle = xlContinuous
.ColorIndex = xlAutomatic
.Weight = xlThin
End With
[login to view URL]("A1").Select
'To save the file
[login to view URL] = False
[login to view URL] "\\test123\Week_" & DatePart("ww", Now()) -1 &".xls"
[login to view URL] = True
[login to view URL] = False
[login to view URL]
Set AppExcel = Nothing
Main = DTSTaskExecResult_Success
Exit Function
End Function