[Webinar] Streamline your web hosting managementRegister Today

x
  • Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 688
  • Last Modified:

Export data into XLS format

Hello,

I am currently using VBscript to export data into CSV and send the report file in an email.

I wanted to use the same procedure however export the data into .xls file format and name the sheet tab to "Sheet1"

I have tried using the attached but its not working for me.

Please can someone advise?

Thanks
D
MM_GR_STRING = "ConnectionString"


Dim Recordset1
Dim Recordset1_numRows
Dim EmailBody

Set Recordset1 = CreateObject("ADODB.Recordset")
Recordset1.ActiveConnection = MM_GR_STRING

strSQL = "SELECT * FROM viewWeeklyrdersReport ORDER BY DateProcessed"             
               
Recordset1.Source = strSQL
Recordset1.CursorType = 0
Recordset1.CursorLocation = 2
Recordset1.LockType = 1
Recordset1.Open()
Recordset1_numRows = 0

VarDate = Date
VarLen = len(VarDate)
If VarLen = 10 then 'xx-xx-xxxx
Var1 = Left(VarDate , 2)
Var3 = Right(VarDate , 4)
Var2 = Mid(VarDate , 4, 2)

elseif VarLen = 9 AND Mid(VarDate , 2, 1) = "/" then 'x-xx-xxxx
Var1 = Left(VarDate , 1)
Var3 = Right(VarDate , 4)
Var2 = Mid(VarDate , 3, 2)
Var1 = "0"&Var1

elseif VarLen = 9 AND Mid(VarDate , 3, 1) = "/" then 'xx-x-xxxx
Var1 = Left(VarDate , 2)
Var3 = Right(VarDate , 4)
Var2 = Mid(VarDate , 4, 1)
Var2 = "0"&Var2

else 'x-x-xxxx
Var1 = Left(VarDate , 1)
Var3 = Right(VarDate , 4)
Var2 = Mid(VarDate , 3, 1)
Var1 = "0"&Var1
Var2 = "0"&Var2
end if

VarDate = Var2&Var1&Var3
VarQ = """"

set objComm = CreateObject("ADODB.Command")
objComm.ActiveConnection = MM_GR_STRING

set FSO = CreateObject("scripting.FileSystemObject") 'text file
GoodsFileName = "Goods_045799_" & Right("0" & Day(Now), 2) & Right("0" & Month(Now), 2) & Year(Now)
OutputDir = "D:\WEB\WeeklyWebReports\"
set myFile = fso.CreateTextFile(OutputDir & GoodsFileName & ".csv", true)  
myFile.Write("""Invoice Type"",""Supplier Name"",""Supplier No"",""SAP Supplier No"",""Address Line 1"",""Address Line 2"",""Address Line 3"",""City/County"",""Postcode"",""Country"",""Y order number"",""Item Number"",""Quantity"",""Net Cost (EX VAT)"",""VAT"",""Invoice Number Goods"",""Invoice Date""")
 
While Not Recordset1.EOF
       
        ' Web Orders CSV ##################################################################
	'IF Cint(Recordset1.Fields.Item("DropShipQty").Value) > 1 Then
	'Total = Cint(Recordset1.Fields.Item("DropShipQty").Value) * Cdbl(Recordset1.Fields.Item("NetPrice").Value)
	'Else
	Total = Recordset1.Fields.Item("NetPrice").Value
        'End IF
        myFile.Write VbCrLf 
        myFile.Write "Goods," 'Invoice Type
        myFile.Write "1232," 'OrderID    
        myFile.Write "045799," 'Supplier No
        myFile.Write "1000026617," 'SAP Supplier No
        myFile.Write "4 Road," 'Address Line 1
	myFile.Write "test," 'Address Line 2
	myFile.Write "test," 'Address Line 3
        myFile.Write "London," 'City/County        
        myFile.Write "ES14gs," 'Postcode
        myFile.Write "UK," 'Country       
        myFile.Write """" & Trim((Recordset1.Fields.Item("DropShipRetailerOrderID").Value)) & """," 'Y order number
        myFile.Write """" & Trim((Recordset1.Fields.Item("ProdID").Value)) & """," 'Item Number       
        myFile.Write "1," 'Quantity
        myFile.Write """" & Trim(Total) & """," 'Net Cost (EX VAT)      
        myFile.Write """" & Trim((Recordset1.Fields.Item("NetVAT").Value)) & """," 'VAT        
        myFile.Write "," 'Invoice Number Goods       
        myFile.Write "," 'Invoice Date       
        Recordset1.MoveNext
Wend
 
myFile.Close 'close the text files

Open in new window

0
daira
Asked:
daira
  • 4
  • 4
  • 3
  • +1
2 Solutions
 
gavsmithCommented:
Take a look at the following script. I was going to extract the bit you required but I can't bring myself to do it, I have to give credit to the author because it's a pretty awesome script... it's actually a HTML application but has the VBscript you require in it... hope it helps, enjoy

http://community.spiceworks.com/scripts/show/915-remote-uninstall-software-hta?utm_source=swemail&utm_medium=email&utm_campaign=resource

0
 
dairaAuthor Commented:
Hi gavsmith

Thanks for the link. I have had a look but unable to figure out how I can use the attached for my code?

Please advise

Thanks
Set objRange = objWorkSheet.Range("A1:Z5")
				Set objRange2 = objWorkSheet.Range("A5:F" & intStartRow - 1)
				Set objRange3 = objWorkSheet.Range("E:F")
				Set objRangeH = objWorkSheet.Range("A5:F5")
				
				objRange.Font.Bold = True
				objRange2.Borders.LineStyle = xlContinuous
				objRange2.Borders.Weight = xlThin
				objRange2.Borders.ColorIndex = xlAutomatic
				objRange3.ColumnWidth = 75
				objRange3.WrapText = True
				objRangeH.AutoFilter
				
				objWorksheet.Range("A6").Select
				objExcel.ActiveWindow.FreezePanes = "True"
				objWorksheet.Range("A1").Select
				
				objWorkSheet.Columns("A:ZZ").EntireColumn.AutoFit
				objExcel.DisplayAlerts = False
				objExcel.ActiveWorkbook.SaveAs(strTemp & "\SoftwareDetails" & strPC & ".xls")
				objExcel.Visible = True
				Set objExcel = Nothing

Open in new window

0
 
TommySzalapskiCommented:
You could use this code and just fill in your data using the Range
Set objExcel = CreateObject("Excel.Application")

Set objBook = objExcel.Workbooks.Add()
objExcel.Visible = True

'Delete all but the first worksheet
For i = objBook.Worksheets.Count To 2 Step -1
  objBook.Worksheets(i).Delete
Next

Set objSheet = objBook.Worksheets(1)

objSheet.Range("A1") = "Column 1's title"
objSheet.Range("B1") = "Column 2's title"
'Etc etc

rownum = 2

'Then have your loop here and write out each row using something like
objSheet.Cells(rownum, 1) = "Column 1's data for this record"
objSheet.Cells(rownum,2) = "Column 2's data for this record"
'etc

'If you don't want it to ask if you want to overwrite the file, uncomment these lines.
'objExcel.DisplayAlerts = False
objBook.SaveAs "C:\temp\junk.xls"
'objExcel.DisplayAlerts = True 

objBook.Close
objExcel.Quit

Open in new window

0
The new generation of project management tools

With monday.com’s project management tool, you can see what everyone on your team is working in a single glance. Its intuitive dashboards are customizable, so you can create systems that work for you.

 
TommySzalapskiCommented:
You could also just convert the csv file into an xls file like this
Set objExcel = CreateObject("Excel.Application")

Set objBook = objExcel.Workbooks.Open("C:\temp\junk.csv")
objExcel.Visible = True

'Rename worksheet
objBook.Worksheets(1).Name = "Sheet1"

objExcel.DisplayAlerts = False
objBook.SaveAs "C:\temp\junk.xls", 56 '56 is xls format
objExcel.DisplayAlerts = True 

objBook.Close True

objExcel.Quit

Open in new window

0
 
gavsmithCommented:
The bit of the script you posted is just setting some formating in the the sheet (ranges, filters, frozen pane etc) above that has the data export parts

line 971 - case 2 (sets up the sheet and header)
line 1045 - starts the loop
line 1078 - put the data into the sheet

its nice that it checks that excel is installed first.

0
 
Bill PrewCommented:
I think this should be pretty close to what you need.  Couldn't test it here, let me know how it goes there.

MM_GR_STRING = "ConnectionString"

Dim Recordset1
Dim Recordset1_numRows
Dim EmailBody

Set Recordset1 = CreateObject("ADODB.Recordset")
Recordset1.ActiveConnection = MM_GR_STRING

strSQL = "SELECT * FROM viewWeeklyrdersReport ORDER BY DateProcessed"             
               
Recordset1.Source = strSQL
Recordset1.CursorType = 0
Recordset1.CursorLocation = 2
Recordset1.LockType = 1
Recordset1.Open()
Recordset1_numRows = 0

VarDate = Date
VarLen = len(VarDate)
If VarLen = 10 then 'xx-xx-xxxx
Var1 = Left(VarDate , 2)
Var3 = Right(VarDate , 4)
Var2 = Mid(VarDate , 4, 2)

elseif VarLen = 9 AND Mid(VarDate , 2, 1) = "/" then 'x-xx-xxxx
Var1 = Left(VarDate , 1)
Var3 = Right(VarDate , 4)
Var2 = Mid(VarDate , 3, 2)
Var1 = "0"&Var1

elseif VarLen = 9 AND Mid(VarDate , 3, 1) = "/" then 'xx-x-xxxx
Var1 = Left(VarDate , 2)
Var3 = Right(VarDate , 4)
Var2 = Mid(VarDate , 4, 1)
Var2 = "0"&Var2

else 'x-x-xxxx
Var1 = Left(VarDate , 1)
Var3 = Right(VarDate , 4)
Var2 = Mid(VarDate , 3, 1)
Var1 = "0"&Var1
Var2 = "0"&Var2
end if

VarDate = Var2&Var1&Var3
VarQ = """"

set objComm = CreateObject("ADODB.Command")
objComm.ActiveConnection = MM_GR_STRING

' Start Excel (hidden) and create a new workbook and worksheet for out data
Dim xlApp, xlBook, xlSheet, iRow, iCol, sHeader, sName
Set xlApp = CreateObject("Excel.Application")
Set xlBook = xlApp.Workbooks.Add
Set xlSheet = xlBook.Worksheets(1)
xlApp.visible = False

' Write headers in first row of sheet
sHeader = Split("Invoice Type,Supplier Name,Supplier No,SAP Supplier No,Address Line 1,Address Line 2,Address Line 3,City/County,Postcode,Country,Y order number,Item Number,Quantity,Net Cost (EX VAT),VAT,Invoice Number Goods,Invoice Date", ",")
iRow = 1
iCol=0
For Each sName in sHeader
    iCol = iCol + 1
    xlSheet.Cells(iRow, iCol).Value = Quote(sName)
Next
 
While Not Recordset1.EOF
    ' Move to next row in sheet
    iRow = iRow + 1
    ' Web Orders CSV ##################################################################
    'IF Cint(Recordset1.Fields.Item("DropShipQty").Value) > 1 Then
    'Total = Cint(Recordset1.Fields.Item("DropShipQty").Value) * Cdbl(Recordset1.Fields.Item("NetPrice").Value)
    'Else
    Total = Recordset1.Fields.Item("NetPrice").Value
    'End IF

    ' Populate cells on this row with out data
    xlSheet.Cells(iRow, 1).Value = "Goods" 'Invoice Type
    xlSheet.Cells(iRow, 2).Value = "1232" 'OrderID    
    xlSheet.Cells(iRow, 3).Value = "045799" 'Supplier No
    xlSheet.Cells(iRow, 4).Value = "1000026617" 'SAP Supplier No
    xlSheet.Cells(iRow, 5).Value = "4 Road" 'Address Line 1
    xlSheet.Cells(iRow, 6).Value = "test" 'Address Line 2
    xlSheet.Cells(iRow, 7).Value = "test" 'Address Line 3
    xlSheet.Cells(iRow, 8).Value = "London" 'City/County        
    xlSheet.Cells(iRow, 9).Value = "ES14gs" 'Postcode
    xlSheet.Cells(iRow, 10).Value = "UK" 'Country       
    xlSheet.Cells(iRow, 11).Value = Quote(Trim((Recordset1.Fields.Item("DropShipRetailerOrderID").Value))) 'Y order number
    xlSheet.Cells(iRow, 12).Value = Quote(Trim((Recordset1.Fields.Item("ProdID").Value))) 'Item Number       
    xlSheet.Cells(iRow, 13).Value = "1" 'Quantity
    xlSheet.Cells(iRow, 14).Value = Quote(Trim(Total)) 'Net Cost (EX VAT)      
    xlSheet.Cells(iRow, 15).Value = Quote(Trim((Recordset1.Fields.Item("NetVAT").Value))) 'VAT        
    xlSheet.Cells(iRow, 16).Value = "" 'Invoice Number Goods       
    xlSheet.Cells(iRow, 17).Value = "" 'Invoice Date       

    Recordset1.MoveNext
Wend
 
' Save the excel file with our name
GoodsFileName = "Goods_045799_" & Right("0" & Day(Now), 2) & Right("0" & Month(Now), 2) & Year(Now)
OutputDir = "D:\WEB\WeeklyWebReports\"
xlSheet.SaveAs OutputDir & GoodsFileName
xlApp.Quit
Set xlSheet = Nothing
Set xlBook = Nothing
Set xlApp = Nothing


' Add surrounding double quotes to a string
Function Quote(s)
   Quote = Chr(34) & s & Chr(34)
End Function

Open in new window

~bp
0
 
dairaAuthor Commented:
Thanks everybody for your input. Much appreciated.

TommySzalapski:

Your example code to epxort into xls works great.

I want to run this script on the windows 2003 server - I dont have Excel installed so I am getting applicataion error when I run this script.

All, please can you advise if there is anyway I can create Excel object without having actual Excel software installed?

Thank you.

0
 
Bill PrewCommented:
I'm not aware of a way to create a true XLS file without Excel installed.  You may find some third party component or software that you could use to do that, but it would likely have to be installed on the server anyway.  The typical way to do that is to create a CSV and then load that into Excel.

~bp
0
 
dairaAuthor Commented:
Hello again,

Yes, I can create a CSV using the script above when the problem is when I want to save it / export as .xls

Can I just not save it as .xls after creating a CSV without having excel installed on the server?

All I am trying to do is to send a weekly report in a .xls format to one of the supplier which has a strict requirement to send data in .xls format.

Please advise

Thanks
0
 
Bill PrewCommented:
No, you cannot save CSV formatted data as an XLS.  To do what you want, which is create a true XLS file, you would need Excel installed on the computer that generates that file.

~bp
0
 
TommySzalapskiCommented:
If you don't want Excel on the server than you either don't want to install anything or don't want to spend any money.
There is a free, third party library that is supposed to do that
http://code.google.com/p/excellibrary/
It uses .NET so you would have to use it to make an executable that you would call from the vbscript

If you save it using tab characters instead of commas, you can just call it an .xls file and it will open correctly in Excel (but it will give a warning about file format).
0
 
TommySzalapskiCommented:
But it would probably be easier to just find and old copy of Office 2003 and install Excel on the server.
0
 
dairaAuthor Commented:
Thanks all. I have installed Excel on the server and its working OK now.

thank you once again.
0

Featured Post

The new generation of project management tools

With monday.com’s project management tool, you can see what everyone on your team is working in a single glance. Its intuitive dashboards are customizable, so you can create systems that work for you.

  • 4
  • 4
  • 3
  • +1
Tackle projects and never again get stuck behind a technical roadblock.
Join Now