Convert Excel workbook to CSV with user-provided filenames - vbscript

First, I need to delete the top 4 rows from the sheet either before or after the conversion. There currently isn't anything in this script that will delete rows from the Excel file or from the CSV file that it creates.
Second, I'd prefer to pass the source and destination in this script rather then passing them later. Currently this script requires a command line to pass the source and destination it looks something like this.
C:\exceltocsv "source.xls" "destination.csv"
Instead of requiring source.xls and destination.csv to be provided as commandline arguments I'd rather have them resolved in the VBScript itself. Is this possible?
if WScript.Arguments.Count < 2 Then
WScript.Echo "Error! Please specify the source path and the destination. Usage: XlsToCsv SourcePath.xls Destination.csv"
Wscript.Quit
End If
Dim oExcel
Set oExcel = CreateObject("Excel.Application")
Dim oBook
Set oBook = oExcel.Workbooks.Open(Wscript.Arguments.Item(0))
oBook.SaveAs WScript.Arguments.Item(1), 6
oBook.Worksheets(2).Activate
oBook.Close False
oExcel.Quit
WScript.Echo "Done"

You can use the InputBox function to prompt for user input. Rows can be removed from an Excel worksheet via <range>.EntireRow.Delete.
Something like this should do what you want:
xls = InputBox("Enter source file.")
csv = InputBox("Enter destination file.")
Set oExcel = CreateObject("Excel.Application")
Set oBook = oExcel.Workbooks.Open(xls)
oBook.Sheets(1).Range("1:4").EntireRow.Delete
oBook.SaveAs csv, 6
oBook.Close False
oExcel.Quit
WScript.Echo "Done"
Edit: If you want hardcoded paths, simply define them as strings:
xls = "C:\path\to\input.xls"
csv = "C:\path\to\output.csv"
Set oExcel = CreateObject("Excel.Application")
Set oBook = oExcel.Workbooks.Open(xls)
oBook.Sheets(1).Range("1:4").EntireRow.Delete
oBook.SaveAs csv, 6
oBook.Close False
oExcel.Quit
WScript.Echo "Done"

Thanks to Ansgar Wiechers I was able to come up with this script
xls = "C:\[Path]"
csv = "c:\[Destination]"
Set oExcel = CreateObject("Excel.Application")
Set oBook = oExcel.Workbooks.Open(xls)
oBook.Worksheets(2).Activate
oBook.Worksheets(2).Rows("1:4").Delete
oBook.SaveAs csv, 6
oBook.Close False
oExcel.Quit
And it runs like a champ in cmd. Thanks a million!
However, I went to implement this into my process and found out that SQL Server Agent has major issues in executing VBScripts.
cscript is the command that is suggested to execute the script, but it doesn't work. After more research I found that other people have had similar issues and they all suggest writing the script in VB.NET instead of VBScript. This way SSIS can process the script.
Ansgar I marked your response as the answer since it answered my question, but sadly it only lead me to a dead end with VBScript.

Related

Spaces and carriage returns are being added to HTML email

We have a server generated HTML file (myFile.html) that we embed in emails that get sent to our clients. We've been using this method for years with minimal issues. We use Windows Server 2012 with smtp server via II6. Recently the HTML is getting skewed in the email. When checking the source file, all looks well. Directly opening the HTML file for viewing in a browser works as you'd expect. Here is the code we're using to read the file into memory to prepare for emailing:
Set objFile = objFSO.OpenTextFile(strFilePath)
Do While objFile.AtEndOFStream <>True
line = objFile.ReadLine
If Instr(1, line, "<table") > 0 And strHeaderWritten = "N" Then
strHeaderWritten = "Y"
strFileContent=strFileContent & strHeader
End If
strFileContent=strFileContent & line
Loop
set objFile = Nothing
And then we add the content to the email and send:
strBody = strFileContent
Set objMail = CreateObject("CDO.Message")
Set objMail.Configuration = cdoConfig
objMail.From = strFrom
objMail.ReplyTo = strReplyTo
objMail.To = strTo
objMail.Subject = strSubject
objMail.HTMLBody = strBody
objMail.Fields("urn:schemas:httpmail:importance").Value = strImportance
objMail.Send
And here are examples of what it spits out in the email. There are no errors in the source:
Has anyone else had this happen to them?
Been toiling over this for hours looking for an explanation. Thank so much for reading!
I tried using the ADO Stream method for the email, but it is still coming out the same:
Dim objStream
Set objStream = Server.CreateObject("ADODB.Stream")
objStream.Type = 2 'adTypeText
objStream.CharSet = Application("CharacterSet")
objStream.Open
objStream.LoadFromFile strFilePath
Do While Not objStream.EOS
line = objStream.ReadText(-2)
If Instr(1, line, "<table") > 0 And strHeaderWritten = "N" Then
strHeaderWritten = "Y"
strFileContent=strFileContent & strHeader
End If
If Instr(1, line, "< table") > 0 Then
strFileContent=strFileContent & "<h3>Broken HTML</h3>"
End If
strFileContent=strFileContent & line
Loop
objStream.Close
Set objStream = Nothing
As you can see, I also added a check for one of the persistent errors I'm seeing where there has been a space inserted between < and table. Checking the output this way did not capture the issue as in checking the text for the added space. So it must be happening after it's been written or I need to use a regex for the test. I'll try that next. I'm still seeing it in multiple email clients. Here's an example post test of ADO Stream:
This seems to be a common problem in CDO. I've found a few references online to the problem that spaces are randomly inserted into the HTMLbody.
One answer was to make the HTML body not one long string, because CDO will then insert random spaces, but to include whitespace yourself, so that CDO doesn't have to.
You could try adding VbCrLf or just plain spaces in the text you're sending.
A second suggestion made more sense to me; this can be an encoding problem. That also explains why adding your own whitespace could be a workaround.
Anyway; CDO allows for setting the encoding of the CDO.Message object before sending.
Try objMail.BodyPart.ContentTransferEncoding = "quoted-printable" to see if that solves it.
The issue is windows use of both line break and carrage return. I recommend loading the body of the text and replacing all instances of vbcrlf with just vblf and you will find you wont have the double spacing anymore.
e.g.
body = replace(body, vbcrlf, vblf)

It is necessary to write a vbs script to run multiple xlam files in one excel instance

The task is to write vbs scripts that:
The first vbs script (1.vbs) opens an excel instance and loads the 1.xlam file into the open excel instance.
The second vbs script (2.vbs) loads the 2.xlam file into the same excel instance.
The next one (3.vbs) loads the same instance of excel 3.xlam and so on.
I tried a lot, but I have new *.xlam being loaded into new instances of excel, not the previously opened one.
How to solve a problem?
My loader1.vbs - for load loader1.xlsm
Set omExcel = CreateObject("excel.application")
omExcel.Visible = True
vmAlertXLSM = omExcel.AutomationSecurity
omFile.AutomationSecurity = 1
vmFile = replace(WScript.ScriptFullName, ".vbs",".xlsm")
omExcel.Workbooks.Open vmFile
omExcel.AutomationSecurity = vmAlertXLSM
This Ok
I need to write loader2.vbs which loads my loader2.xlsm to the same Excel instance so that the functions written in loader1.xlsm and loader2.xlsm can see each other
It doesn't work like that - a new instance of Excel opens:
vmFile = replace(WScript.ScriptFullName, ".vbs",".xlsm")
With GetObject(, "Excel.Application")
.Visible = True
.Workbooks.Open (vmFile)
End With
Excel Instances
You can open a file in a new instance of Excel with:
With CreateObject("Excel.Application")
.Visible = True
.Workbooks.Open ("C:\Test1.xlsx")
End With
You can open another file in a running instance with:
With GetObject(, "Excel.Application")
.Workbooks.Open ("C:\Test2.xlsx")
' Prove that your in the same instance:
ReDim wbNames(.Workbooks.Count - 1)
For Each wb In .Workbooks
wbNames(n) = wb.FullName
n = n + 1
Next
MsgBox "Open Workbooks: " & vbLf & vbLf & Join(wbNames, vbLf)
End With

VBScript overwrite file

I'm using the following script to convert an Excel file into a CSV tab delimited txt file.
xls = "C:\Ristken Data Load\Wade SPIFF log file"
csv = "c:\Ristken Data Load\Wade SPIFF log file"
Set oExcel = CreateObject("Excel.Application")
Set oBook = oExcel.Workbooks.Open(xls)
oBook.Worksheets(2).Activate
oBook.Worksheets(2).Rows("1:4").Delete
oBook.SaveAs csv, -4158
oBook.Close True
oExcel.Quit
I'd like to add something to this script so that, it overwrites the txt file each time it runs without having the popup box asking if you want to overwrite the existing file.
Easier then I thought it would be.
xls = "C:\Ristken Data Load\Wade SPIFF log file"
csv = "c:\Ristken Data Load\Wade SPIFF log file"
Set oExcel = CreateObject("Excel.Application")
Set oBook = oExcel.Workbooks.Open(xls)
oBook.Application.DisplayAlerts = False
oBook.Worksheets(2).Activate
oBook.Worksheets(2).Rows("1:4").Delete
oBook.SaveAs csv, -4158
oBook.Close True
oExcel.Quit

unzip file silently vbscript

I found online script that basically unzip every .zip archive in a given path.
sub UnzipAll(path)
set folder = fso.GetFolder(path)
for each file in folder.files
if (fso.GetExtensionName(file.path)) = "zip" then
set objShell = CreateObject("Shell.Application")
objshell.NameSpace(path).CopyHere objshell.NameSpace(file.path).Items
file.delete
end if
next
end sub
This is actually working, but the problem is that I want to unzip "silently" (silently means that I don't want any kind of message from the system when unzipping, like "do you want to overwrite?" ect.).
I've searched a lot on google and I found that you just need to add a few flags on the "CopyHere" method, like this:
objshell.NameSpace(path).CopyHere objshell.NameSpace(file.path).Items, *FLAGHERE*
But the problem is right here. The flags would normally work, but they are completely ignored when unzipping a .zip archive.
So I searched for a workaround, but I didn't find anything helpful.
I managed to do it by myself. Basically you want to unzip 1 file per time and not everyone togheter, and before copying it you just check if it already exists, and evenutally delete it:
set fso = CreateObject("Scripting.FileSystemObject")
sub estrai(percorso)
set cartella = fso.GetFolder(percorso)
for each file in cartella.files
if fso.GetExtensionName(file.path) = "zip" then
set objShell = CreateObject("Shell.Application")
set destinazione = objShell.NameSpace(percorso)
set zip_content = objShell.NameSpace(file.path).Items
for i = 0 to zip_content.count-1
'msgbox fso.Buildpath(percorso,zip_content.item(i).name)+"."+fso.getExtensionName(zip_content.item(i).path)
if (fso.FileExists(fso.Buildpath(percorso,zip_content.item(i).name)+"."+fso.getExtensionName(zip_content.item(i).path))) then
'msgbox "il file esiste, ora lo cancello"
fso.DeleteFile(fso.Buildpath(percorso,zip_content.item(i).name)+"."+fso.getExtensionName(zip_content.item(i).path))
end if
destinazione.copyHere(zip_content.item(i))
next
file.Delete
end if
next
'for each sottocartella in cartella.subfolders
' call estrai(folder.path)
'next
end sub
call estrai("C:\Documents and Settings\Mattia\Desktop\prova")

Converting Microsoft XML file format to Excel file

I have requirement that I'm not really sure on how to go about it. I have a file Doc.xml, this is in Microsoft XML format. I need to create a VB script that will change/convert the Doc.xml to Doc.xlsx, so when the user tries to open the file it will open as an Excel file.
One of the requirements is that this script will be run from the Windows Scheduler.
Any ideas or recommendation will be really appreciated.
This is the script I created and is working, but when I try to change the SaveAs extension to ".csv" the file is not being saved correctly. I guess I need to find out what the code is for saving in CSV.
Dim objXLApp, objXLWb, objXLWs
Set objXLApp = CreateObject("Excel.Application")
objXLApp.Visible = True
Set objXLWb = objXLApp.Workbooks.Open("C:\Users\jmejia\Desktop\XML_F\ZOOSHR_130622.xml")
'Do nothing with File, just open it to be save agains as a new file format
objXLWb.SaveAs "C:\Users\jmejia\Desktop\XML_F\ZOOSHR_130622.xlsx", 51
objXLWb.Close (False)
Set objXLWs = Nothing
Set objXLWb = Nothing
objXLApp.Quit
Set objXLApp = Nothing
If your file was created and exported from Excel > 2006? then it will have the tags in it such that double clicking in explorer on a windows machine with any Excel that supports xml format will automatically open it in Excel.
Your file is likely to start with something like:
<?xml version="1.0"?>
<?mso-application progid="Excel.Sheet"?>
<Workbook xmlns="urn:schemas-microsoft-com:office:spreadsheet"
xmlns:o="urn:schemas-microsoft-com:office:office"
xmlns:x="urn:schemas-microsoft-com:office:excel"
xmlns:ss="urn:schemas-microsoft-com:office:spreadsheet"
xmlns:html="http://www.w3.org/TR/REC-html40">
<DocumentProperties xmlns="urn:schemas-microsoft-com:office:office">
Const xlXLSX = 51
REM 51 = xlOpenXMLWorkbook (without macro's in 2007-2013, xlsx)
REM 52 = xlOpenXMLWorkbookMacroEnabled (with or without macro's in 2007-2013, xlsm)
REM 50 = xlExcel12 (Excel Binary Workbook in 2007-2013 with or without macro's, xlsb)
REM 56 = xlExcel8 (97-2003 format in Excel 2007-2013, xls)
dim args
dim file
dim sFile
set args=wscript.arguments
dim wshell
Set wshell = CreateObject("WScript.Shell")
Set objExcel = CreateObject("Excel.Application")
Set objWorkbook = objExcel.Workbooks.Open( wshell.CurrentDirectory&"\"&args(0))
objExcel.DisplayAlerts = FALSE
objExcel.Visible = FALSE
objWorkbook.SaveAs wshell.CurrentDirectory&"\"&args(1), xlXLSX
objExcel.Quit
Wscript.Quit

Resources