VBscript - Transpose CSV File - csv

Does anyone have a short script in VBscript for transposing a Matrix (given as CSV (comma separated values) file)?
A, 1, 2, 3
B, 7, 5, 6
->
A, B
1, 7
2, 5
3, 6
Many Thanks in advance
Tom

So by creating dynamic arrays and auto-increment their growth in parallel with discovering new columns of the original matrix, you can auto build the new data structure quite quickly.
Const OutputCSV = "C:\op.csv"
Dim dt_start, WriteOutput : dt_start = Now
Dim fso : Set fso = CreateObject("Scripting.FileSystemObject")
Dim file : Set file = fso.OpenTextFile("C:\test.csv", 1, True)
Set WriteOutput = fso.OpenTextFile(OutputCSV, 8, True)
Dim fc : fc = file.ReadAll : file.close : Dim fcArray : fcArray = Split(fc, vbCrLf)
WScript.echo "Before Transpose"
WScript.echo "----------------"
WScript.echo fc
WScript.echo "----------------"
Dim opArray() : ReDim opArray(0)
For Each row In fcArray
Dim tmp: tmp = Split(row, ",")
For ent=0 To UBound(tmp)
If ent > UBound(opArray) Then
ReDim Preserve opArray(UBound(opArray)+1)
opArray(ent) = Trim(tmp(ent))
Else
If Len(opArray(ent)) > 0 Then
opArray(ent) = opArray(ent) & "," & Trim(tmp(ent))
Else
opArray(ent) = Trim(tmp(ent))
End If
End If
Next
Next
Dim dt_end : dt_end = Now
WScript.echo "After Transpose"
WScript.echo "----------------"
WScript.echo Join(opArray, vbCrLf)
WScript.echo "----------------"
WScript.echo "Script Execution Time (sec): " & DateDiff("s", dt_start, dt_end)
WriteOutput.Write Join(opArray, vbCrLf) : WriteOutput.Close

If it's just two lines with an equal number of values, you can read both into arrays using the Split function:
a1 = Split(FileIn.ReadLine, ",")
a2 = Split(FileIn.ReadLine, ",")
Then, iterate the arrays and write each element:
For i = 0 To UBound(a1)
FileOut.WriteLine a1(i) & ", " & a2(i)
Next
I'm assuming you know how to open files for reading and writing?
Edit: It sounds like you may have an unknown number of rows to read. In that case, you can use an array of arrays:
Dim a(255) ' Hold up to 255 rows. Adjust as needed. Or use ReDim Preserve to grow dynamically.
Do Until FileIn.AtEndOfStream
a(i) = Split(FileIn.ReadLine, ",")
i = i + 1
Loop
Then, to write:
For j = 0 To UBound(a(0))
' Concatenate the elements into a single string...
s = ""
For k = 0 To i - 1
s = s & a(k)(j) & ","
Next
' Write the string without the final comma...
FileOut.WriteLine Left(s, Len(s) - 1)
Next

Related

Using VBScript to delete a column from CSV file

I need to use VBScript to delete various columns from CSV file.
The columns to be eliminated are from number 101 to number 106.
My code below it does not delete any columns:
Const ForReading = 1, ForWriting = 2, ForAppending = 8
Dim fso, strLine, dataArray, clippedArray()
InputFile="C:\input.csv"
OutputFile="C:\input_n_1.csv"
Set fso = CreateObject("Scripting.FileSystemObject")
Set InFile = fso.OpenTextFile(InputFile, ForReading)
Set OutFile = fso.OpenTextFile(OutputFile, ForWriting, True)
Do While InFile.AtEndOfStream <> True
strLine = InFile.ReadLine
ReDim Preserve clippedArray(x)
clippedArray(x) = Split(strLine,";")
intCount = 0
newLine = ""
For Each Element In clippedArray(x)
If intCount <> (101 OR 102 OR 103 OR 104 OR 105 OR 106) Then
EndChar = "|"
newLine = newLine & Element & EndChar
End If
intCount = intCount + 1
Next
OutFile.WriteLine newLine
Loop
InFile.Close
OutFile.Close
WScript.Echo "Done"
The code inside your loop has a few issues. For example, no value is specified for x when trying to ReDim your clippedArray array. There would be no need to Preserve what's in the array either since you're placing new data in it.
The interior of the loop can be simplified and put into a function like this:
Function GetUpdatedLine(p_sLine)
Dim arrColumns
Dim sNewLine
Dim sEndChar
Dim iCounter
' Split line into columns
arrColumns = Split(p_sLine, ";")
' Initialize variables
sNewLine = ""
sEndChar = "|"
For iCounter = 1 To UBound(arrColumns) + 1
Select Case iCounter
Case 101, 102, 103, 104, 105, 106
' Skip these columns
Case Else
' Add to new line
If sNewLine <> "" Then sNewLine = sNewLine & sEndChar ' Add separator
sNewLine = sNewLine & arrColumns(iCounter - 1) ' arrColumns is a zero-based array
End Select
Next
GetUpdatedLine = sNewLine
End Function
You loop can now be updated to this:
Do While InFile.AtEndOfStream <> True
OutFile.WriteLine GetUpdatedLine(InFile.ReadLine)
Loop

Import CSV and force all fields to Text format

I am importing a series of CSV files into Access tables. I have the following line that imports each file:
DoCmd.TransferText acImportDelim, , FN, F.Path, True
This import statement works and creates the necessary table. However, it creates the field types from the data, and depending on the first few rows of the data it may create a field as numeric that should be text - and then causes an error when it encounters a text value later in the file.
How can I force the field type to Text for every field in the input file? I've used Import Specifications before, but first the file format (provided by others outside my control) may change from time to time, and second it's a very "wide" file with 200+ column, so this isn't a practical answer.
This is not a great workaround, but I had to go through the process anyway to get around the 255 field limit in tables. In short, the import steps I ended up with are
Read the 1st line of the file as an inputstream
Split the line to get the field names, put them in a data dictionary table and then manually mark the ones I want to import
Use CREATE TABLE to create a new data table (selected fields only) with all of the fields set to TEXT
Read each line of the file as an inputstream
Split the line to get the data for each field
Use INSERT INTO to add the selected fields to the data table
Cumbersome, but it solves both problems - I'm not limited to 255 fields in the input files and I can control the data type of the fields as I create them.
The code, if anyone cares, is
Function Layout()
Set db = CurrentDb()
Folder = DLookup("[data folder]", "folder")
Dim FSO As New FileSystemObject
Set flist = FSO.GetFolder(Folder).Files
db.Execute ("delete * from [data dictionary]")
For Each F In flist
FN = Left(F.Name, InStr(F.Name, ".") - 1)
FT = Mid(F.Name, InStr(F.Name, ".") + 1)
If FT <> "csv" Then GoTo Skip
If TestFile(F.path) = "ASCII" Then
Set instream = FSO.OpenTextFile(F.path, ForReading, , 0)
Else: Set instream = FSO.OpenTextFile(F.path, ForReading, , -1)
End If
header = instream.ReadLine
Data = Split(header, ",")
For i = LBound(Data) To UBound(Data)
SQL = "insert into [data dictionary] ([table], [field], [index]) select "
SQL = SQL & "'" & FN & "','" & Data(i) & "','" & i & "'"
db.Execute SQL
Next i
Skip: Next F
End Function
Function TestFile(ByVal path As String)
Dim buffer As String
Dim InFileNum As Integer
Dim firstByte As Integer
Dim secondByte As Integer
Dim thirdByte As Integer
buffer = String(100, " ")
InFileNum = FreeFile
Open path For Binary Access Read As InFileNum
Get InFileNum, , buffer
Close InFileNum
firstByte = Asc(Mid(buffer, 1, 1))
secondByte = Asc(Mid(buffer, 2, 1))
thirdByte = Asc(Mid(buffer, 3, 1))
If (firstByte = 255 And secondByte = 254) Then
TestFile = "Unicode"
ElseIf (firstByte = 254 And secondByte = 255) Then
TestFile = "Unicode"
ElseIf (firstByte = 239 And secondByte = 187 And thirdByte = 191) Then
TestFile = "Unicode"
Else
TestFile = "ASCII"
End If
End Function
Function import()
Folder = DLookup("[data folder]", "folder")
Set db = CurrentDb()
Dim FSO As New FileSystemObject
Set Tlist = db.OpenRecordset("select [table] from [data dictionary] where ([required]<>'') group by [table]")
Tlist.MoveFirst
Do While Not Tlist.EOF
TN = Tlist.Fields("table").Value
Delete_table (TN)
Set flist = db.OpenRecordset("select * from [data dictionary] where [required]<>'' and [table]='" & TN & "'")
flist.MoveFirst
Text = ""
Do While Not flist.EOF
FN = flist.Fields("Field")
Text = Text & "," & FN & " " & IIf(InStr(FN, "Date") > 0 Or InStr(FN, "_DT") > 0, "DATETIME", "TEXT")
flist.MoveNext
Loop
SQL = "CREATE TABLE " & TN & "(" & Mid(Text, 2) & ")"
db.Execute SQL
path = Folder & "\" & TN & ".csv"
If TestFile(path) = "ASCII" Then
Set instream = FSO.OpenTextFile(path, ForReading, , 0)
Else: Set instream = FSO.OpenTextFile(path, ForReading, , -1)
End If
header = instream.ReadLine
Do While Not instream.AtEndOfStream
Line = parser(instream.ReadLine)
Data = Split(Line, ",")
flist.MoveFirst
Text = ""
Do While Not flist.EOF
n = flist.Fields("index").Value
Text = Text & ",'" & Data(n) & "'"
flist.MoveNext
Loop
SQL = "insert into [" & TN & "] values(" & Mid(Text, 2) & ")"
db.Execute SQL
Loop
Tlist.MoveNext
Loop
x = MultipleCodes()
MsgBox ("done")
End Function
Function parser(S)
parser = S
i = InStr(S, Chr(34))
If i = 0 Then
parser = S
Else
j = InStr(i + 1, S, Chr(34))
T = Mid(S, i + 1, j - i - 1)
T = Replace(T, ",", ";")
parser = Left(S, i - 1) & T & parser(Mid(S, j + 1))
End If
End Function

insert an array into mysql using vb.net vs vba

I have retrieve all data from the internet into a 2 dimension array, I know how to use vba recordset and by filter and update using loop. Below is part of the code in vba.
the difficult problem is here:
Using cmd As New MySqlCommand("INSERT INTO `calls` (`CID`, `ctype`) VALUES (#CID, #ctype)", cnn)
This make me could not use any loop through the array and update accordingly.
cmd.Parameters.Add ('#CID').value = arrValue(i,j)
I hope this could be done in kind of below:
for x = 0 to ubound(arrValue,0)
for y = 0 to ubound(arrValue,1)
.fields(arrHeader(y) = arrValue(x,y)
next y
next x
say i, the n-th to be updated, j = the value of the header
extract of vba:
With rs
'Worksheets(strWsName).Activate
'iLastRow = Worksheets(strWsName).Cells(65535, 1).End(xlUp).row 'column B, column 2
For i = 0 To UBound(arrValue, 1)
Debug.Print "Updating " & i + 1 & " of " & UBound(arrValue, 1) + 1 & " news ..." ' of " & strCodeAB & " ..."
'Start looping the news row
strNewsID = arrValue(i, 1) 'Worksheets(strWsName).Range(ColRefNewsID & i).Value
If strNewsID = "" Then
Debug.Print i - 1 & " news is updated to database"
i = UBound(arrValue, 1)
Else
strFilter = "fID='" & strNewsID & "'"
rs.Filter = strFilter
If rs.EOF Then
.AddNew 'create a new record
'add values to each field in the record
For j = 0 To UBound(arrTitle_ALL)
'20140814
strFieldValue = .Fields(arrAccessField(j))
strNewValue = arrValue(i, j)
If IsNull(strFieldValue) And strNewValue = "" Then
Else
.Fields(arrAccessField(j)) = arrValue(i, j) 'Worksheets(strWsName).Cells(i, j + 1).Value
End If
Next j
On Error Resume Next '***************
.Update 'stores the new record
On Error GoTo 0
iCounterNewsAdded = iCounterNewsAdded + 1
glcounterNewsAdded = iCounterNewsAdded
Else
It seems that the below post similar to my request but I don't know how to do so.
[reference]passing an Array as a Parameter to be used in a SQL Query using the "IN" Command
The post you mention (Using the IN() command) works in your WHERE clause but it is not valid for values. MySQL has no way to pass an array so you need to loop through your array and run multiple INSERT statements:
for y = 0 to ubound(arrValue,1)
cmd.Parameters.AddWithValue(#CID,arrValue(0,y))
cmd.Parameters.AddWithValue(#ctype,arrValue(1,y))
cmd.ExecuteNonQuery
next y

Getting random characters when writing SMS message to .CSV (VBScript)

I am using the the program FrontlineSMS and some code written in VBScript to take incoming SMS messages and log them to a CSV file. However, random characters such as percents and numbers are ending up in the CSV file even though they are not in the SMS. Below is an example of what I mean:
I send an SMS with my phone to the modem connected to the computer reading
"07/12/2013 11:29:56 25 Happy Holidays"
The modem then receives the message and passes it on the script, which outputs it to a .CSV file. However when I open the file it reads:
"07%2F12%2F2013 | 11%3A29%3A56 | 25 | Happy | Holidays |
Where each word is in its own cell. I need help in figuring out how to get rid of the extra characters that show up (like "%2F"), my guess is that it has to do with the encryption/decryption of the characters when converting to .CSV but I don't know where to start looking to solve this.
Edit: I found out that it has to do with the ASCII coding. "%2F" is Hex for a slash "/", but I still don't know how to prevent this from happening.
Thanks!
Here is the entire script:
Option Explicit
Dim first, secnd
Dim fso, outFile
Dim strFile, strValues, strLine, strInfo
Dim stamp, num, i, identify
Const ForAppending = 8
'error handling/format
'Settings
identify = WScript.Arguments(1)
CStr(identify)
stamp = MyDate()
CStr(stamp)
strFile = "C:\SMScomm\Log\" &identify &" " &stamp & " log.csv"
'Create the file system object
Set fso = CreateObject("Scripting.FileSystemObject")
'Check whether argument were passed
If WScript.Arguments.Count <> 1 Then
WScript.Echo "No arguments were passed"
End If
strInfo = WScript.Arguments(0)
'Replace(strInfo, "%2C", ",")
'Split the argument from FSMS so it reads normally
strValues = Split(strInfo, "+")
'Open to append
Set outFile = fso.OpenTextFile(strFile, ForAppending, True)
num = UBound(strValues)
If num = 0 then
WScript.Echo "Formatting error"
End If
Do while i < num + 1
strValues(i) = strValues(i) & ","
i = i + 1
Loop
'Write to the .csv
i = 0
Do while i < num + 1
outFile.Write(strValues(i) + " ")
i = i + 1
Loop
outFile.WriteBlankLines(1)
'Close the file
outFile.Close
'Clean up
Set outFile = Nothing
Set fso = Nothing
Function MyDate()
Dim dteCurrent, dteDay, dteMonth, dteYear
dteCurrent = Date()
dteDay = Day(dteCurrent)
dteMonth = Month(dteCurrent)
dteYear = Year(dteCurrent)
MyDate = dteMonth & "-" & dteDay & "-" & dteYear
End Function
It looks like either your script or the modem is converting special characters such as "/" into their Hex format.
Can you post the script that dumps this information into CSV format?
Option Explicit
Dim first, secnd
Dim fso, outFile
Dim strFile, strValues, strLine, strInfo
Dim stamp, num, i, identify
Const ForAppending = 8
'error handling/format
'Settings
identify = WScript.Arguments(1)
CStr(identify)
stamp = MyDate()
CStr(stamp)
strFile = "C:\SMScomm\Log\" &identify &" " &stamp & " log.csv"
'Create the file system object
Set fso = CreateObject("Scripting.FileSystemObject")
'Check whether argument were passed
If WScript.Arguments.Count <> 1 Then
WScript.Echo "No arguments were passed"
End If
strInfo = WScript.Arguments(0)
'Replace(strInfo, "%2C", ",")
'Split the argument from FSMS so it reads normally
strValues = Split(strInfo, "+")
'Open to append
Set outFile = fso.OpenTextFile(strFile, ForAppending, True)
num = UBound(strValues)
If num = 0 then
WScript.Echo "Formatting error"
End If
Do while i < num + 1
strValues(i) = strValues(i) & ","
i = i + 1
Loop
'Write to the .csv
i = 0
Do while i < num + 1
Replace(strValues(i), '%2F', '/')
Replace(strValues(i), '%3A', ':')
outFile.Write(strValues(i) + " ")
i = i + 1
Loop
outFile.WriteBlankLines(1)
'Close the file
outFile.Close
'Clean up
Set outFile = Nothing
Set fso = Nothing
Function MyDate()
Dim dteCurrent, dteDay, dteMonth, dteYear
dteCurrent = Date()
dteDay = Day(dteCurrent)
dteMonth = Month(dteCurrent)
dteYear = Year(dteCurrent)
MyDate = dteMonth & "-" & dteDay & "-" & dteYear
End Function
I am sure there is a more elegant way of doing this but it should solve your problem.

VBScript - Find specific term in between commas in .csv and append columns based on values found

I am trying to append additional columns to an existing .csv file called Original.csv, but the values to be appended should vary base on whether an N or a J is part of the value between the 4th comma and the 5th comma in Original.csv (technically the 5th column if the file were opened in Excel). Below are the codes I wrote. They don't work, so it's for your reference only. Thanks in advance for your help.
rowCounter = 1
Do Until objOriginal.AtEndofStream
strOriginal = objOriginal.ReadLine
arrOriginal = Split(strOriginal, ",")
arrType = Split(arrOriginal(5),",")
strType = arrType(1)
If IsTrue(InStr(strType,"N")) Then
strOriginal = objOriginal.ReadLine & ",Type N,USD"
objPosition.WriteLine(strOriginal)
Else
strOriginal = objOriginal.ReadLine & ",Type J,USD"
objPosition.WriteLine(strOriginal)
End If
rowCounter = rowCounter + 1
Loop
The proper tool for .csv files is ADO. All you need to create a new (text) table by appending columns to an existing table is an SQL statement like:
SELECT S.*, 'whatever' & (IIF([B]='J','-j', '-n')) As [NewCol] INTO [dst.csv] FROM [src.csv] S
and - in general - a schema.ini file like
[src.csv]
ColNameHeader=True
Format=Delimited(;)
Col1=A Integer
Col2=B Char Width 15
[dst.csv]
ColNameHeader=True
Format=Delimited(;)
Col1=A Integer
Col2=B Char Width 15
Col3=NewCol Char Width 15
to specify your table structures unequivocally.
In code:
' Absolute path to .CSV folder
Dim oFS : Set oFS = CreateObject("Scripting.FileSystemObject")
Dim sDS : sDS = oFS.GetAbsolutePathName("..\Data\txt")
' Connectionstring
Dim sCS : sCS = Join(Array( _
"Provider=Microsoft.Jet.OLEDB.4.0" _
, "Data Source=" & sDS _
, "Extended Properties=""" & Join(Array( _
"Text" _
, "HDR=Yes" _
), ";") & """" _
), ";")
' Database/Connection
Dim oDb : Set oDb = CreateObject("ADODB.Connection")
Dim sSQL
oDb.Open sCS
' show src
sSQL = "SELECT * FROM [src.csv]"
WScript.Echo sSQL
WScript.Echo oDb.Execute(sSQL).GetString(adClipString, , vbTab, vbCrLf, "null")
' copy/append col to new dst
If oFS.FileExists(oFS.BuildPath(sDS, "dst.csv")) Then oFS.DeleteFile oFS.BuildPath(sDS, "dst.csv")
sSQL = "SELECT S.*, 'whatever' & (IIF([B]='J','-j', '-n')) As [NewCol] INTO [dst.csv] FROM [src.csv] S"
WScript.Echo "--------------"
WScript.Echo "Exec:", sSQL
oDb.Execute sSQL
' show dst
sSQL = "SELECT * FROM [dst.csv]"
WScript.Echo "--------------"
WScript.Echo sSQL
WScript.Echo oDb.Execute(sSQL).GetString(adClipString, , vbTab, vbCrLf, "null")
output:
SELECT * FROM [src.csv]
1 J
2 N
3 J
4 N
--------------
Exec: SELECT S.*, 'whatever' & (IIF([B]='J','-j', '-n')) As [NewCol] INTO [dst.csv] FROM [src.csv] S
--------------
SELECT * FROM [dst.csv]
1 J whatever-j
2 N whatever-n
3 J whatever-j
4 N whatever-n
That way you reduce the risk of blunders like
polluting your code with un-used (und un-usable) variables (rowcounter)
trying to split an element from an array created by split on the same separator
accessing the next/wrong line by .ReadLine() twice
to zero
If you are looking for a simple down and dirty method...
Const ForReading = 1
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFile = objFSO.OpenTextFile("C:\Path\Original.csv", ForReading, False)
arrLines = Split(objFile.ReadAll, vbCrLf)
objFile.Close
Set objFile = objFSO.CreateTextFile("C:\Path\Appended.csv", True)
For Each strLine In arrLines
strType = Split(strLine, ",")(4)
Select Case True
Case InStr(1, strType, "N", 1) > 0
objFile.WriteLine strLine & ",Type N,USD"
Case InStr(1, strType, "J", 1) > 0
objFile.WriteLine strLine & ",Type J,USD"
Case Else
objFile.WriteLine strLine
End Select
Next
objFile.Close
First you will want to open and read the file to a variable, you can split each line in the process. Close the file
Create a New file to write to and loop through each line.
You can pull out the 5th column by doing a split and using the (#) can return only the value for that place in the array.
Do a select case checking for the string value and rewrite the line plus your two column values to the new file
close the new file when your done with the loop...
Like I said its down and dirty and may need some adjustments and modifications depending on the actual file and values being used, but it should work for your purpose.