-
Jul 10th, 2020, 11:02 AM
#1
Thread Starter
New Member
How to make CsvToCsvConverter.vbs based on following code
Hello!
I have; XlsxToCsvConverter.vbs (see the code at the bottum).
How do I make this code convert Csv UTF-8 to the same Csv with semi-colon separation? I tried to change XLSX and xlsx with CSV without any luck. Yes I am a newbie.
Code:
WScript.Echo "Converting from xlsx to vbs. Press ok to continue." 'prints startup message
on error resume next
Dim fso, fullpath, oExcel, wBook, getbase
Set fso = CreateObject("Scripting.FileSystemObject")
fullpath = fso.GetAbsolutePathName(folderName) 'get the path of the current folder
objStartFolder = fullpath
Set objFolder = fso.GetFolder(objStartFolder)
Set colFiles = objFolder.Files
Set oExcel = CreateObject("Excel.Application")
oExcel.DisplayAlerts = False
'Checks for existing CSV folder and creates one if none exist
If Not fso.FolderExists(fullPath + "\CSV") Then
fso.CreateFolder(fullpath + "\CSV")
End If
For Each objFile in colFiles 'searches through all files in the current folder
If UCase(fso.GetExtensionName(objFile.name)) = "XLSX" Or fso.GetExtensionName(objFile.name) = "xlsx" Then 'finds xls files
Set wBook = oExcel.Workbooks.Open(objFile) 'open the files in Excel
getbase = fso.getbasename(fullpath + "\" + objFile) 'get the name of the file
'save the new file. With the same name. As csv. And True saves the files against Microsoft excel including control panel settings too get semicolon
'separation opposed to comma separation, change to "local" to use local settings.
wBook.SaveAs fullpath + "\CSV\" + getbase, 6, 0, 0, 0, 0, 0, 0, 0, 0, 0, True
wBook.Close False 'closes workbook without saving changes; change to True if you want to save changes to the workbook
End If
Next
oExcel.Quit
'prints error messages
If Err.Number <> 0 Then
MsgBox "Error: " & Err.Description
End If
WScript.Echo "Done."
-
Jul 10th, 2020, 12:33 PM
#2
Re: How to make CsvToCsvConverter.vbs based on following code
If you have a question about VBScript then you ought to post it in the VBScript forum. I've asked the mods to move this thread.
-
Jul 10th, 2020, 12:54 PM
#3
Re: How to make CsvToCsvConverter.vbs based on following code
Welcome to VBForums
I have moved this thread from our 'VB.Net' forum to our 'VBScript' forum
-
Jul 10th, 2020, 01:18 PM
#4
Thread Starter
New Member
Re: How to make CsvToCsvConverter.vbs based on following code
Thx!
-
Jul 13th, 2020, 04:50 AM
#5
Thread Starter
New Member
Re: How to make CsvToCsvConverter.vbs based on following code
-
Jul 15th, 2020, 04:14 AM
#6
Re: How to make CsvToCsvConverter.vbs based on following code
Originally Posted by Razzy
Hello!
I have; XlsxToCsvConverter.vbs (see the code at the bottum).
How do I make this code convert Csv UTF-8 to the same Csv with semi-colon separation? I tried to change XLSX and xlsx with CSV without any luck. Yes I am a newbie.
Code:
WScript.Echo "Converting from xlsx to vbs. Press ok to continue." 'prints startup message
on error resume next
Dim fso, fullpath, oExcel, wBook, getbase
Set fso = CreateObject("Scripting.FileSystemObject")
fullpath = fso.GetAbsolutePathName(folderName) 'get the path of the current folder
objStartFolder = fullpath
Set objFolder = fso.GetFolder(objStartFolder)
Set colFiles = objFolder.Files
Set oExcel = CreateObject("Excel.Application")
oExcel.DisplayAlerts = False
'Checks for existing CSV folder and creates one if none exist
If Not fso.FolderExists(fullPath + "\CSV") Then
fso.CreateFolder(fullpath + "\CSV")
End If
For Each objFile in colFiles 'searches through all files in the current folder
If UCase(fso.GetExtensionName(objFile.name)) = "XLSX" Or fso.GetExtensionName(objFile.name) = "xlsx" Then 'finds xls files
Set wBook = oExcel.Workbooks.Open(objFile) 'open the files in Excel
getbase = fso.getbasename(fullpath + "\" + objFile) 'get the name of the file
'save the new file. With the same name. As csv. And True saves the files against Microsoft excel including control panel settings too get semicolon
'separation opposed to comma separation, change to "local" to use local settings.
wBook.SaveAs fullpath + "\CSV\" + getbase, 6, 0, 0, 0, 0, 0, 0, 0, 0, 0, True
wBook.Close False 'closes workbook without saving changes; change to True if you want to save changes to the workbook
End If
Next
oExcel.Quit
'prints error messages
If Err.Number <> 0 Then
MsgBox "Error: " & Err.Description
End If
WScript.Echo "Done."
Hello Razzy,
Welcome to the forum! I tried your program on an .xlsx file and it does produce semi colon delimited .csv files as you appear to be asking. Perhaps you could rephrase your question?
Also I rewrote your code somewhat:
Code:
Option Explicit
Dim colFiles
Dim folderName
Dim fso
Dim fullpath
Dim getbase
Dim objFile
Dim objFolder
Dim objStartFolder
Dim oExcel
Dim wBook
WScript.Echo "Converting from xlsx to vbs. Press ok to continue."
Set fso = CreateObject("Scripting.FileSystemObject")
fullpath = fso.GetAbsolutePathName(folderName)
objStartFolder = fullpath
Set objFolder = fso.GetFolder(objStartFolder)
Set colFiles = objFolder.Files
Set oExcel = CreateObject("Excel.Application")
oExcel.DisplayAlerts = False
If Not fso.FolderExists(fullPath + "\CSV") Then fso.CreateFolder(fullpath + "\CSV")
For Each objFile in colFiles
If UCase(fso.GetExtensionName(objFile.name)) = "XLSX" Then
Set wBook = oExcel.Workbooks.Open(objFile)
getbase = fso.getbasename(fullpath + "\" + objFile)
wBook.SaveAs fullpath + "\CSV\" + getbase, 6, 0, 0, 0, 0, 0, 0, 0, 0, 0, True
wBook.Close False
End If
Next
oExcel.Quit
If Err.Number <> 0 Then MsgBox "Error: " & Err.Description
WScript.Echo "Done."
A few tips:
1. Don't use On Error Resume Next unless you are certain you want to ignore errors. Also the Err object would not have contained any error codes when using your code because On Error Resume Next would have skipped over any errors.
2. I strongly recommend using the Option Explicit directive as well. It ensures you declare all your variables. If you declare them at the top of your procedure you have a nice overview of your variables.
yours,
Peter Swinkels
-
Jul 15th, 2020, 02:49 PM
#7
Thread Starter
New Member
Re: How to make CsvToCsvConverter.vbs based on following code
Originally Posted by Peter Swinkels
Welcome to the forum! I tried your program on an .xlsx file and it does produce semi colon delimited .csv files as you appear to be asking. Perhaps you could rephrase your question?
- First of all, thank you very much for taking the time.
- Thanks for the great tips regarding errors and cleaning up the code - beautiful!
What I need:
- I simply need the program to convert from Csv UTF-8 (not Xlsx).
- I still want the end product to be Csv semicolon separation.
I'm going to take a closer look at your improvements.
Hope I explained my wish well enough.
Cheers.
-
Jul 15th, 2020, 03:03 PM
#8
Thread Starter
New Member
Re: How to make CsvToCsvConverter.vbs based on following code
Your code works perfectly as long as the name of the file did not become too long / complicated: "Rocky - balboa - 19.06." does not work but "Rocky-balboa" works fine.
Furthermore, when I replace "xlsx" with "csv" I get a Csv output with ANSI. I need it to be Csv ANSI with W-1252 I believe.
Code:
For Each objFile in colFiles
If UCase(fso.GetExtensionName(objFile.name)) = "CSV" Or fso.GetExtensionName(objFile.name) = "csv" Then
Set wBook = oExcel.Workbooks.Open(objFile) 'open the files in Excel
getbase = fso.getbasename(fullpath + "\" + objFile)
wBook.SaveAs fullpath + "\CSV\" + getbase, 6, 0, 0, 0, 0, 0, 0, 0, 0, True
wBook.Close False
The following issues remains:
I need to run Search and replace simple quotes " and double comma ,,. If I did this in notepad it worked perfectly.
Can I get the script to run these two searches and replace the function on all the new Csv files?
Last edited by Razzy; Jul 18th, 2020 at 10:24 AM.
-
Jul 18th, 2020, 11:54 AM
#9
Re: How to make CsvToCsvConverter.vbs based on following code
Originally Posted by Razzy
Your code works perfectly as long as the name of the file did not become too long / complicated: "Rocky - balboa - 19.06." does not work but "Rocky-balboa" works fine.
Furthermore, when I replace "xlsx" with "csv" I get a Csv output with ANSI. I need it to be Csv ANSI with W-1252 I believe.
Code:
For Each objFile in colFiles
If UCase(fso.GetExtensionName(objFile.name)) = "CSV" Or fso.GetExtensionName(objFile.name) = "csv" Then
Set wBook = oExcel.Workbooks.Open(objFile) 'open the files in Excel
getbase = fso.getbasename(fullpath + "\" + objFile)
wBook.SaveAs fullpath + "\CSV\" + getbase, 6, 0, 0, 0, 0, 0, 0, 0, 0, True
wBook.Close False
The following issues remains:
I need to run Search and replace simple quotes " and double comma ,,. If I did this in notepad it worked perfectly.
Can I get the script to run these two searches and replace the function on all the new Csv files?
I fixed some of your issues and reworked the code:
Code:
Option Explicit
Const xlCSV = 6
Private fso
Call Main
Public Sub Main()
Dim csvFolder
Dim xlsFolder
WScript.Echo "Converting from xlsx to csv. Press ok to continue."
Set fso = CreateObject("Scripting.FileSystemObject")
xlsFolder = fso.GetAbsolutePathName(".")
csvFolder = xlsFolder & "\CSV"
ConvertXLSToCSV xlsFolder, csvFolder
If Err.Number <> 0 Then MsgBox "Error: " & Err.Description
WScript.Echo "Done."
End Sub
Private Sub ConvertXLSToCSV(xlsFolder, csvFolder)
Dim colFiles
Dim getbase
Dim objFile
Dim ObjFolder
Dim oExcel
Dim wBook
Set objFolder = fso.GetFolder(xlsFolder)
If Not fso.FolderExists(csvFolder) Then fso.CreateFolder(csvFolder)
Set oExcel = CreateObject("Excel.Application")
oExcel.DisplayAlerts = False
Set colFiles = objFolder.Files
For Each objFile in colFiles
If UCase(fso.GetExtensionName(objFile.name)) = "XLSX" Then
Set wBook = oExcel.Workbooks.Open(objFile)
getbase = fso.getbasename(xlsFolder & "\" & objFile)
If Right(getbase, 1) = "." Then getbase = getbase & "csv"
wBook.SaveAs csvFolder & "\" & getbase, xlCSV, , , , , , , , , , True
wBook.Close False
End If
Next
oExcel.Quit
End Sub
I will get back to the other issues.
EDIT:
What do you mean with simple quotes? Single quotes? And what do you want to replace duplicate commas with?
-
Jul 18th, 2020, 01:14 PM
#10
Re: How to make CsvToCsvConverter.vbs based on following code
Originally Posted by Peter Swinkels
I fixed some of your issues and reworked the code:
Code:
Option Explicit
Const xlCSV = 6
Private fso
Call Main
Public Sub Main()
Dim csvFolder
Dim xlsFolder
WScript.Echo "Converting from xlsx to csv. Press ok to continue."
Set fso = CreateObject("Scripting.FileSystemObject")
xlsFolder = fso.GetAbsolutePathName(".")
csvFolder = xlsFolder & "\CSV"
ConvertXLSToCSV xlsFolder, csvFolder
If Err.Number <> 0 Then MsgBox "Error: " & Err.Description
WScript.Echo "Done."
End Sub
Private Sub ConvertXLSToCSV(xlsFolder, csvFolder)
Dim colFiles
Dim getbase
Dim objFile
Dim ObjFolder
Dim oExcel
Dim wBook
Set objFolder = fso.GetFolder(xlsFolder)
If Not fso.FolderExists(csvFolder) Then fso.CreateFolder(csvFolder)
Set oExcel = CreateObject("Excel.Application")
oExcel.DisplayAlerts = False
Set colFiles = objFolder.Files
For Each objFile in colFiles
If UCase(fso.GetExtensionName(objFile.name)) = "XLSX" Then
Set wBook = oExcel.Workbooks.Open(objFile)
getbase = fso.getbasename(xlsFolder & "\" & objFile)
If Right(getbase, 1) = "." Then getbase = getbase & "csv"
wBook.SaveAs csvFolder & "\" & getbase, xlCSV, , , , , , , , , , True
wBook.Close False
End If
Next
oExcel.Quit
End Sub
I will get back to the other issues.
EDIT:
What do you mean with simple quotes? Single quotes? And what do you want to replace duplicate commas with?
Here's a new version of your script:
Code:
Option Explicit
const ForReading = 1
Const xlCSV = 6
Private fso
Call Main
Public Sub Main()
Dim csvFolder
Dim xlsFolder
WScript.Echo "Converting from xlsx to csv. Press ok to continue."
Set fso = CreateObject("Scripting.FileSystemObject")
xlsFolder = fso.GetAbsolutePathName(".")
csvFolder = xlsFolder & "\CSV"
ConvertXLSToCSV xlsFolder, csvFolder
ReformatCSVFiles csvFolder
If Err.Number <> 0 Then MsgBox "Error: " & Err.Description
WScript.Echo "Done."
End Sub
Private Sub ConvertXLSToCSV(xlsFolder, csvFolder)
Dim colFiles
Dim getbase
Dim objFile
Dim objFolder
Dim oExcel
Dim wBook
Set objFolder = fso.GetFolder(xlsFolder)
If Not fso.FolderExists(csvFolder) Then fso.CreateFolder(csvFolder)
Set oExcel = CreateObject("Excel.Application")
oExcel.DisplayAlerts = False
Set colFiles = objFolder.Files
For Each objFile in colFiles
If UCase(fso.GetExtensionName(objFile.name)) = "XLSX" Then
Set wBook = oExcel.Workbooks.Open(objFile)
getbase = fso.getbasename(xlsFolder & "\" & objFile)
If Right(getbase, 1) = "." Then getbase = getbase & "csv"
wBook.SaveAs csvFolder & "\" & getbase, xlCSV, , , , , , , , , , True
wBook.Close False
End If
Next
oExcel.Quit
End Sub
Private Sub ReformatCSVFiles(csvFolder)
Dim colFiles
Dim objFile
Dim objFolder
Dim oLines
Dim row
Set objFolder = fso.GetFolder(csvFolder)
Set colFiles = objFolder.Files
For Each objFile in colFiles
If UCase(fso.GetExtensionName(objFile.name)) = "CSV" Then
Set oLines = ReadFileLines(csvFolder & "\" & objFile.Name)
For row = 0 To oLines.Count - 1
oLines(row) = oLines(row) ''Adjust this line of code to make whatever changes required to the line's contents.
Next
WriteFileLines csvFolder & "\" & objFile.Name, oLines
End If
Next
End Sub
Private Function ReadFileLines(filename)
Dim line
Dim oFile
Dim oLines
Dim row
Set oFile = fso.OpenTextFile(filename, ForReading)
Set oLines = CreateObject("Scripting.Dictionary")
row = 0
Do Until OFile.AtEndOfStream
line = oFile.Readline
oLines.Add row, line
row = row + 1
Loop
oFile.Close
Set ReadFileLines = oLines
End Function
Private Sub WriteFileLines(filename, oLines)
Dim line
Dim oFile
Set oFile = fso.CreateTextFile(filename, True)
For Each line In oLines.items
oFile.WriteLine(line)
Next
oFile.Close
End Sub
There is a line of code marked as "''Adjust this line of code to make whatever changes required to the line's contents." If you make changes to that line or add new code to the For loop it's in you should be able to make the required changes to your csv files.
-
Jul 22nd, 2020, 03:01 PM
#11
Thread Starter
New Member
Re: How to make CsvToCsvConverter.vbs based on following code
Originally Posted by Peter Swinkels
Here's a new version of your script:
First of all Peter, thank you very much for your efforts and quick answers. Outstanding work!
While I was inactive on the forum, I got a different approach idea. What if I record the macro in Excel and run the macro via. script and bat file.
I have these three files in the same folder:
This is the result:
1. script.vbs
Code:
Dim args, objExcel
Set args = wscript.Arguments
Set objExcel = CreateObject("Excel.Application")
objExcel.workbooks.Open args(0)
objExcel.visible = True
objExcel.Run "Macro_in_Excel"
objExcel.Activateworkbook.Save
objExcel.Activateworkbook.Close(0)
objExcel.Quit
2. Run.bat.
Code:
cscript script.vbs "C:\Users\%username%\Documents\Template.xlsm"
- I make a shortcut to desktop.
3. Template.xlsm
Code:
Sub Macro_in_Excel()
Dim FilePicker As FileDialog
Dim myPath As String
'Optimize Macro Speed
Application.ScreenUpdating = False
Application.EnableEvents = False
Application.Calculation = xlCalculationManual
Application.DisplayAlerts = False
Set FilePicker = Application.FileDialog(msoFileDialogFilePicker)
With FilePicker
.Title = "Choose singel-file for CSV-konvertering"
.AllowMultiSelect = False
If .Show <> -1 Then GoTo NextCode
myPath = .SelectedItems(1)
End With
NextCode:
myPath = myPath
If myPath = "" Then GoTo ResetSettings
Path = "C:\Users\" & Environ("username") & "\Desktop"
Workbooks.OpenText Filename:=myPath, _
Origin:=65001, StartRow:=1, DataType:=xlDelimited, TextQualifier:= _
xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, Semicolon:=True, _
Comma:=False, Space:=False, Other:=False, FieldInfo:=Array(Array(1, 1), _
Array(2, 1), Array(3, 1), Array(4, 1), Array(5, 1), Array(6, 1), Array(7, 1), Array(8, 1), Array(9, 1), Array(10, 1), Array(11, 1), Array(12, 1)), TrailingMinusNumbers:=True
ChDir Path
ActiveWorkbook.SaveAs Filename:=myPath, _
FileFormat:=xlCSV, CreateBackup:=False
Application.Quit
ActiveWorkbook.Close
ActiveWorkbook.Close
ResetSettings:
'Reset Macro Optimization Settings
Application.EnableEvents = True
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
Application.DisplayAlerts = True
ActiveWorkbook.Save
Application.Quit
End Sub
Referance.:
I will have a closer look at your work.
I think maybe the method above that I presented gives me easier coding possibilites because of the "Recorde macro button".
-
Jul 23rd, 2020, 02:10 AM
#12
Re: How to make CsvToCsvConverter.vbs based on following code
Originally Posted by Razzy
First of all Peter, thank you very much for your efforts and quick answers. Outstanding work!
While I was inactive on the forum, I got a different approach idea. What if I record the macro in Excel and run the macro via. script and bat file.
I have these three files in the same folder:
This is the result:
1. script.vbs
Code:
Dim args, objExcel
Set args = wscript.Arguments
Set objExcel = CreateObject("Excel.Application")
objExcel.workbooks.Open args(0)
objExcel.visible = True
objExcel.Run "Macro_in_Excel"
objExcel.Activateworkbook.Save
objExcel.Activateworkbook.Close(0)
objExcel.Quit
2. Run.bat.
Code:
cscript script.vbs "C:\Users\%username%\Documents\Template.xlsm"
- I make a shortcut to desktop.
3. Template.xlsm
Code:
Sub Macro_in_Excel()
Dim FilePicker As FileDialog
Dim myPath As String
'Optimize Macro Speed
Application.ScreenUpdating = False
Application.EnableEvents = False
Application.Calculation = xlCalculationManual
Application.DisplayAlerts = False
Set FilePicker = Application.FileDialog(msoFileDialogFilePicker)
With FilePicker
.Title = "Choose singel-file for CSV-konvertering"
.AllowMultiSelect = False
If .Show <> -1 Then GoTo NextCode
myPath = .SelectedItems(1)
End With
NextCode:
myPath = myPath
If myPath = "" Then GoTo ResetSettings
Path = "C:\Users\" & Environ("username") & "\Desktop"
Workbooks.OpenText Filename:=myPath, _
Origin:=65001, StartRow:=1, DataType:=xlDelimited, TextQualifier:= _
xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, Semicolon:=True, _
Comma:=False, Space:=False, Other:=False, FieldInfo:=Array(Array(1, 1), _
Array(2, 1), Array(3, 1), Array(4, 1), Array(5, 1), Array(6, 1), Array(7, 1), Array(8, 1), Array(9, 1), Array(10, 1), Array(11, 1), Array(12, 1)), TrailingMinusNumbers:=True
ChDir Path
ActiveWorkbook.SaveAs Filename:=myPath, _
FileFormat:=xlCSV, CreateBackup:=False
Application.Quit
ActiveWorkbook.Close
ActiveWorkbook.Close
ResetSettings:
'Reset Macro Optimization Settings
Application.EnableEvents = True
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
Application.DisplayAlerts = True
ActiveWorkbook.Save
Application.Quit
End Sub
Referance.:
I will have a closer look at your work.
I think maybe the method above that I presented gives me easier coding possibilites because of the "Recorde macro button".
You're welcome!
Posting Permissions
- You may not post new threads
- You may not post replies
- You may not post attachments
- You may not edit your posts
-
Forum Rules
|
Click Here to Expand Forum to Full Width
|