Best way to delete bad record from csv file using VBA - vba

The following script works by adding the bad records to the exception my file.
I just need the best way to delete the bad records from the source file after it's copied.
Public Sub readopentextfile()
Const ForReading = 1, ForWriting = 2, ForAppending = 8
Dim oFS, oFSO, oFSW
Dim stext As String
Set oFSO = CreateObject("Scripting.FileSystemObject")
'/ Open new DailySalesOrds for reading
Set oFS = oFSO.OpenTextFile("C:\DailySalesOrds.csv", ForReading)
'/ Open exception file for writing
Set oFSW = oFSO.OpenTextFile("C:\DailySalesOrderExcep.csv", ForAppending)
'/ Read each record and count commas if 21 or more add record to exception file
Do Until oFS.AtEndOfStream
stext = oFS.ReadLine
Do
c = InStr(c + 1, stext, ",")
If c <> 0 Then Count = Count + 1
Loop Until c = 0
'Debug.Print Count
If Count >= 21 Then
oFSW.Write (vbNewLine & stext)
End If
c = 0
Count = 0
Loop
End Sub

Write the good lines to a new file
Rename the source file with the extension .bak
Rename the new file as the original source file

Related

How to insert a text into text file using VBA

I want to insert a string at a particular position in text file of "utf-8" format.
let say the content in the file is "12367890"
now i want to insert "45" after "3" i.e at position 3,
now the content in the file becomes "1234567890"
I wrote some piece of but it is not working
dim str as string
Dim binaryObj As Object
str = "12367890"
Set binaryObj = CreateObject("adodb.stream")
binaryObj.Open
binaryObj.Charset = "UTF-8"
binaryObj.Type = 2
h = 0
For h = 0 To length
jpByte = Mid(jpString, h + 1, 1)
binaryObj.WriteText jpByte
Next
binaryObj.WriteText ChrW(0)
binaryObj.Position = 6
binaryObj.WriteText "4"
binaryObj.Position = 7
binaryObj.WriteText "5"
binaryObj.SaveToFile "D:\A4\Message_tool\withBom.bin", adSaveCreateOverWrite
Instead of inserting 4 and 5, these are gettin replaced with 6 & 7.
output = "12345890"
As you may have guessed, "WriteText" overwrites the text at that position, rather than inserting. Instead, write everything up until the new character insertion point (after the "3"), write the "4" and "5", then output the rest.
You may find it easier to read the file into a string, then manipulate the string with the built-in string functions, then output to the file, instead of manipulating text files.
You can create a temp file with the modified text and replace this existing file. Here is a proof of concept.
Public Sub TextFileModify()
Dim fso As New FileSystemObject
Dim text As String, line As String, temp As String
Dim path As String, fs As TextStream, fs2 As TextStream
'First create a text file with original content
path = fso.BuildPath(fso.GetSpecialFolder(2), "textfile.txt")
Set fs = fso.CreateTextFile(path, True)
fs.WriteLine "12367890"
fs.WriteLine "other stuff"
fs.Close
'Now open the file to replace a line of text
temp = fso.BuildPath(fso.GetSpecialFolder(2), fso.GetTempName())
Set fs = fso.OpenTextFile(path, ForReading)
Set fs2 = fso.CreateTextFile(temp)
While Not fs.AtEndOfStream
If fs.line = 1 Then
line = fs.ReadLine
fs2.WriteLine Left(line, 3) & "45" & Mid(line, 4)
Else
fs2.WriteLine fs.ReadLine
End If
Wend
fs.Close
fs2.Close
'New delete old file and replace with new file
fso.DeleteFile path
fso.MoveFile temp, path
' textfile.txt now contains "1234567890" in the first line and the rest of the file is identical
End Sub
Notes:
You have to add a reference to the Microsoft Scripting Runtime (per. Example here)
fso.GetSpecialFolder(2) returns the path to your temp folder.
fso.GetTempName() returns a filename like radA5FC8.tmp

Reading text files with specific prefix

I have a folder with lots of text files each containing (but in random order) :
A = ...
B = ...
C = ...
Now I would like to import these text files into an excel-spreadsheet,
where each of the prefixes is organized in the colums, and the files are listed as rows
Example: 2 files
File 1:
A = 1
B = 2
C = 3
File 2:
A = 4
B = 5
C = 6
I would the excel to look like :
NR / A / B / C
1 / 1 /2 /3
2 / 4/ 5 /6
I am still learning VB, and this is just a bit over the top for me.
I have found a macro like this:
Sub Read_Text_Files()
Dim sPath As String, sLine As String
Dim oPath As Object, oFile As Object, oFSO As Object
Dim r As Long
'Files location
sPath = "C:\Test\"
r = 1
Set oFSO = CreateObject( _
"Scripting.FileSystemObject")
Set oPath = oFSO.GetFolder(sPath)
Application.ScreenUpdating = False
For Each oFile In oPath.Files
If LCase(Right(oFile.Name, 4)) = ".txt" Then
Open oFile For Input As #1 ' Open file for input.
Do While Not EOF(1) ' Loop until end of file.
Input #1, sLine ' Read data
If Left(sLine, 1) = "A=" Then 'Now i need to write this to the first column of that row
If Left(sLine, 1) = "B=" Then 'For the second column.
Range("A" & r).Formula = sLine ' Write data line
r = r + 1
Loop
Close #1 ' Close file.
End If
Next oFile
Application.ScreenUpdating = True
End Sub
Do you know how to open files in VBA for reading using syntax like Open and Line Input?
If not, read this: https://stackoverflow.com/a/11528932/2832561
I found this by googling for "VBA open file read"
Do you know how to work with and parse strings (and arrays) using functions like Mid, Left, Right, Split and Join?
If not, try reading this: http://www.exceltrick.com/formulas_macros/vba-split-function/
I found this by googling for "VBA String functions parse text"
Do you know how to work with Workbook and Worksheet objects and assign values to Range objects in Excel?
If not, try reading this: http://www.anthony-vba.kefra.com/vba/vbabasic2.htm
I found this by googling for "Workbook Worksheet Range VBA"
Once you have had a chance to try putting together a solution using these pieces, you can post specific questions on any issues you run into.

Nested Loop Not Working vb.net

I am trying to read file names from source directory and then read a separate file to rename and move files to target directory. Below code reads the file names but the problem is it only reading the contents of app.ini file only once i.e. for first file name. Code is not looping app.ini as soon as for loops switches to second file name.
Dim di As New IO.DirectoryInfo("D:\Transcend")
Dim diar1 As IO.FileInfo() = di.GetFiles()
Dim dra As IO.FileInfo
If (di.GetFiles.Count > 0) Then
Dim a As Integer = 1
Dim b As Integer = 1
For Each dra In diar1
ComboBox1.Items.Add(dra.FullName.ToString)
Using reader2 As New IO.StreamReader("D:\Transcend\test\app.ini")
Do While reader2.Peek() >= 0
Dim line2 = reader2.ReadLine
Do Until line2 Is Nothing
'line2 = reader2.ReadLine()
'ComboBox1.Items.Add(line2.ToString)
'Label1.Text = line2
If line2 <> Nothing Then
If line2.Contains("filename" + a.ToString) Then
Dim values() As String = line2.Split(CChar(":")).ToArray
Dim values2() As String = values(1).Split(CChar(";")).ToArray() 'full filename
Dim values3() As String = values(2).Split(CChar(";")).ToArray() 'keyword to be replaced in filename
Dim values4() As String = values(3).Split(CChar(";")).ToArray() 'fullname in place of keyword
Dim values5() As String = values(4).Split(CChar(";")).ToArray 'destination drive letter
Dim values6() As String = values(5).Split(CChar(";")).ToArray 'destination path after drive letter
ComboBox1.Items.Add(values2(0))
ComboBox1.Items.Add(values3(0))
ComboBox1.Items.Add(values4(0))
ComboBox1.Items.Add(values5(0) + ":" + values6(0))
'Label1.Text = dra.Name.ToString
If dra.Name.ToString.Contains(values2(0)) Then
Dim n As String = dra.Name.Replace(values3(0), values4(0))
File.Copy(dra.FullName, values5(0) + ":" + values6(0) + n)
End If
End If
End If
Exit Do
Loop
a = a + 1
Loop
reader2.Close()
End Using
b = b + 1
Next
Label1.Text = b
Else
MsgBox("No files!")
End
End If
ouput image:
Above image is to show the output and error, first line is the filename1 and the next 8 lines are the output of the app.ini file. As you can see as soon as the filename1 changes to the next file name i.e. Autorun.inf in the 9th line of the above image the same 8 lines of app.ini(line 2nd to 9th in the above image) should be reiterated after Autorun.inf file name but app.ini is not getting to read after file name increments to Autorun.inf and then to FreeSoftware(JF).htm.
The only difference between the first and the second file are the a and b values.
On the first run a will start from 1 and it will be incremented for each line in the app.ini file. After reading 8 lines, the final value of a will be 9.
For the second file, the value a isn't reset so it's value will still be 9. This means that the following condition will never be true because the first run only found value from 1 to 8 *.
If line2.Contains("filename" + a.ToString) Then
To fix your issue, you must set the a variable value back to 1 between each file:
Using reader2 As New IO.StreamReader("D:\Transcend\test\app.ini")
a = 1
Do While reader2.Peek() >= 0
* I'm assuming that the filename in your .ini file are sorted (i.e. line containing filename9 isn't listed before filename2) and that no external process changed the content of your .ini file between the first and the second file.

VBScript to read specific line and extract characters and store it as a variable

I have a VB script that reads the 11th line from a text file. However from that line I need to extract characters 48 through 53 and save it as a variable. After this is accomplished I would like to use that variable and use it in a web url. Example below:
Contents of the szCPUSer.dat file look like this:
The script I have reads the 10th line
Const ForReading = 1
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objTextFile = objFSO.OpenTextFile("szCPUSer.dat", ForReading)
For i = 1 to 10
objTextFile.ReadLine
Next
strLine = objTextFile.ReadLine
Wscript.Echo strLine
objTextFile.Close
I need the script to extract 03187 from the 11th line than store it as a variable SerNum. after this I would like to use that number extracted in a url for example:
http://seriallookup.com/serial=SerNum
The following works!
Const ForReading = 1
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objTextFile = objFSO.OpenTextFile("szCPUSer.dat", ForReading)
For i = 1 to 10
objTextFile.ReadLine
Next
strLine = objTextFile.ReadLine
Wscript.Echo strLine
objTextFile.Close
'Gets 6 chars starting from Right side
SerNum = Right(strLine, 6)
'Gets 6 chars starting from Left side
SerNum = Left(SerNum, 5)
'Wscript.Echo SerNum
url = "http://seriallookup.com/serial=" & SerNum
Wscript.Echo url
Take a look at InStr function. It lets you search for a substring.
http://www.w3schools.com/vbscript/func_instr.asp
Then you can use the Right function to parse out the end bit of the line.
You can also look at the Split function so you can parse the lines into arrays and deal with it that way which would be best.
http://www.w3schools.com/vbscript/func_split.asp

Function to count number of lines in a text file

Need a function that will accept a filename as parameter and then return the number of lines in that file.
Should be take under 30 seconds to get the count of a 10 million line file.
Currently have something along the lines of - but it is too slow with large files:
Dim objFSO, strTextFile, strData, arrLines, LineCount
CONST ForReading = 1
'name of the text file
strTextFile = "sample.txt"
'Create a File System Object
Set objFSO = CreateObject("Scripting.FileSystemObject")
'Open the text file - strData now contains the whole file
strData = objFSO.OpenTextFile(strTextFile,ForReading).ReadAll
'Split by lines, put into an array
arrLines = Split(strData,vbCrLf)
'Use UBound to count the lines
LineCount = UBound(arrLines) + 1
wscript.echo LineCount
'Cleanup
Set objFSO = Nothing
If somebody still looking for faster way, here is the code:
Const ForAppending = 8
Set fso = CreateObject("Scripting.FileSystemObject")
Set theFile = fso.OpenTextFile("C:\textfile.txt", ForAppending, Create:=True)
WScript.Echo theFile.Line
Set Fso = Nothing
Of course, the processing time depend very much of the file size, not only of the lines number. Compared with the RegEx method TextStream.Line property is at least 3 times quicker.
The only alternative I see is to read the lines one by one (EDIT: or even just skip them one by one) instead of reading the whole file at once. Unfortunately I can't test which is faster right now. I imagine skipping is quicker.
Dim objFSO, txsInput, strTemp, arrLines
Const ForReading = 1
Set objFSO = CreateObject("Scripting.FileSystemObject")
strTextFile = "sample.txt"
txsInput = objFSO.OpenTextFile(strTextFile, ForReading)
'Skip lines one by one
Do While txsInput.AtEndOfStream <> True
txsInput.SkipLine ' or strTemp = txsInput.ReadLine
Loop
wscript.echo txsInput.Line-1 ' Returns the number of lines
'Cleanup
Set objFSO = Nothing
Incidentally, I took the liberty of removing some of your 'comments. In terms of good practice, they were superfluous and didn't really add any explanatory value, especially when they basically repeated the method names themselves, e.g.
'Create a File System Object
... CreateObject("Scripting.FileSystemObject")
Too large files...
The following is the fastest-effeciently way I know of:
Dim oFso, oReg, sData, lCount
Const ForReading = 1, sPath = "C:\file.txt"
Set oReg = New RegExp
Set oFso = CreateObject("Scripting.FileSystemObject")
sData = oFso.OpenTextFile(sPath, ForReading).ReadAll
With oReg
.Global = True
.Pattern = "\r\n" 'vbCrLf
'.Pattern = "\n" ' vbLf, Unix style line-endings
lCount = .Execute(sData).Count + 1
End With
WScript.Echo lCount
Set oFso = Nothing
Set oReg = Nothing
You could try some variation on this
cnt = 0
Set fso = CreateObject("Scripting.FileSystemObject")
Set theFile = fso.OpenTextFile(filespec, ForReading, False)
Do While theFile.AtEndOfStream <> True
theFile.SkipLine
c = c + 1
Loop
theFile.Close
WScript.Echo c,"lines"
txt = "c:\YourTxtFile.txt"
j = 0
Dim read
Open txt For Input As #1
Do While Not EOF(1)
Input #1, read
j = j + 1
Loop
Close #1
If it adds an empty last line the result is (j - 1).
It works fine for one column in the txt file.
How to count all lines in the notepad
Answers:
=> Below is the code -
Set t1=createObject("Scripting.FileSystemObject")
Set t2=t1.openTextFile ("C:\temp\temp1\temp2_VBSCode.txt",1)
Do Until t2.AtEndOfStream
strlinenumber = t2.Line
strLine = t2.Readline
Loop
msgbox strlinenumber
t2.Close
I was looking for a faster way than what I already had to determine the number of lines in a text file. I searched the internet and came across 2 promising solution. One was a solution based on SQL thew other the solution I found here based on Fso by Kul-Tigin. I tested them and this is part of the result:
Number of lines Time elapsed Variant
--------------------------------------------------------
110 00:00:00.70 SQL
110 00:00:00.00 Vanilla VBA (my solution)
110 00:00:00.16 FSO
--------------------------------------------------------
1445014 00:00:17.25 SQL
1445014 00:00:09.19 Vanilla VBA (my solution)
1445014 00:00:17.73 FSO
I ran this several times with large and small numbers. Time and again the vanilla VBA came out on top. I know this is far out of date, but for anyone still looking for the fastest way to determine the number of lines in a csv/text file, down here's the code I use.
Public Function GetNumRecs(ASCFile As String) As Long
Dim InStream As Long
Dim Record As String
InStream = FreeFile
GetNumRecs = 0
Open ASCFile For Input As #InStream
Do While Not EOF(InStream)
Line Input #InStream, Record
GetNumRecs = GetNumRecs + 1
Loop
Close #InStream
End Function