I am currently using this code snippet in my script for replacing text in an ASCII file
Dim fso, inputFile, outputFile
Dim str As String
Const quote As String = """"
Dim MyFile As String = Folder & "\client-1\com\company\assembleegameclient\parameters\Parameters.class.asasm"
fso = CreateObject("Scripting.FileSystemObject")
inputFile = fso.OpenTextFile(MyFile, 1)
str = inputFile.ReadAll
str = Replace(str, quote & TextBox1.Text & quote, quote & TextBox3.Text & quote)
outputFile = fso.CreateTextFile(MyFile, True)
outputFile.Write(str)
System.Threading.Thread.Sleep(5000)
I put the threading at the end of the to see if it would fix the problem by waiting, but it doesn't work. The next step in the script requires this portion to be completely finished before proceeding. Is there a way to attach this to a process with waitforexit? or something similar that works on strings?
It would be optimal if it would output the number of changes that were made and that it was complete.
Related
I'm New to this forum so please be patient with me, thanks. I am not an expert in VBA. I am from Norway so my english is not the best.
I need to create a text-file generator. The text-files are beeing used as inspection reports in a pipe inspection program.
The text-file must look like this.
[Inspection1]
PipeID=112
FromPointNo=8696
ToPointNo=8292
Street=Trykkeriveien
Date=30.07.2009
Signature=Tho
Weather=B
PreWashed=N
ArchiveRef=
PipeFeature=AF
Material=Bet
Dimension=400
PipeForm=S
VerticalDim=
PipeLength=94,24
Comment= SM=9,6
SD=0
Obs=Distance;Observation;Type;ClockPos;Rank;Photo;VideoPos;Comment
Obs1=0,00;SI;;;0;No;;Start inspection
Obs2=4,38;PC;;0;1;No;;Pipe connection, from 01-12
Obs3=11,55;PC;;2;2;No;;Pipe connection, from 00-11
Obs4=21,21;PC;;1;1;No;;Pipe connection, from 02-12
Obs5=22,56;FI;;;0;No;;Inspection finished
For solving this i have created two tables, one for the inspection and the other for the inspection details.
The difficult part is how to deal with the header (the upper part of the text-file) and the details below.
I have a built up a string that contains the header and it looks exactely like it should. BUT!!! The lower part (the part containing the oberservation details)
I have not solved. I have tried several approaches, but have not suceeded - YET.
Any suggestion on how to proceed?
Best Regards from Anders
This sounds like a job for ADODB.Recordset.GetString!!! This method will wrap field and record values using ColumnDelimiter and RowDelimiter respectively. It allows for fast creation of csv file and even HTML tables.
MSDN - GetString Method (ADO)
Variant = recordset.GetString(StringFormat, NumRows, ColumnDelimiter, RowDelimiter, NullExpr)
test.txt
test.html
Sub TestFile()
Const FILEPATH = "C:\Users\Owner\Documents\stack-overflow\Inspection Reports\test.txt"
Dim OutputString As String
OutputString = getInspectionDetails & vbCrLf & vbCrLf & vbCrLf & getInspection
Open FILEPATH For Output As #1
Print #1, OutputString
Close #1
End Sub
Function getInspection(Optional ColumnDelimeter = ";", Optional RowDelimeter = vbCrLf) As String
Dim rs As ADODB.Recordset
Set rs = New ADODB.Recordset
rs.Open "[Inspection]", CurrentProject.Connection
'RowDelimeter
getInspection = rs.GetString(ColumnDelimeter:=ColumnDelimeter, RowDelimeter:=RowDelimeter, NullExpr:=" ")
rs.Close
Set rs = Nothing
End Function
Function getInspectionDetails(Optional ColumnDelimeter = ";", Optional RowDelimeter = vbCrLf) As String
Dim rs As ADODB.Recordset
Set rs = New ADODB.Recordset
rs.Open "[Inspection Details]", CurrentProject.Connection
getInspectionDetails = rs.GetString(ColumnDelimeter:=ColumnDelimeter, RowDelimeter:=RowDelimeter, NullExpr:=" ")
rs.Close
Set rs = Nothing
End Function
Sub TestHTML()
Const FILEPATH = "C:\Users\Owner\Documents\stack-overflow\Inspection Reports\test.html"
Dim OutputString As String, tBody As String
OutputString = "<!DOCTYPE html><body><table>#tablebody</table></body></html>"
tBody = getInspection(getInspection("</td><td>", "</td></tr>" & vbCrLf & "<tr><td>"))
tBody = "<tr>" & Left(tBody, Len(tBody) - 4)
Open FILEPATH For Output As #1
Print #1, Replace(OutputString, "#tablebody", tBody)
Close #1
End Sub
Basically what I am doing is writing a program that pulls a quote from a website and writes it to a .txt file. It works fine except that I have no idea who to add NewLine into the .txt file. I will just show you the code.
If Not div Is Nothing Then
Dim blank As String = Environment.NewLine
Dim finish As String = (div.InnerText.Trim())
TextBox2.Text = Chr(34) & finish & Chr(34)
Dim fileName As String = Path.Combine(Environment.GetFolderPath(Environment.SpecialFolder.MyDocuments), "Horoscope", "Monthly.txt")
My.Computer.FileSystem.WriteAllText(fileName, Chr(34) & finish & Chr(34), True)
My.Computer.FileSystem.WriteAllText(Path.Combine(Environment.GetEnvironmentVariable("userprofile"), "Documents\Horoscope\Monthly.txt"), blank, True)
My.Computer.FileSystem.WriteAllText(Path.Combine(Environment.GetEnvironmentVariable("userprofile"), "Documents\Horoscope\Monthly.txt"), blank, True)
End If
Now that works fine for the first pair of quotes, but anything after it does not indent due to another section of code that I have that deletes duplicates.
Dim lines As String() = IO.File.ReadAllLines(Path.Combine(Environment.GetFolderPath(Environment.SpecialFolder.MyDocuments), "Horoscope", "Monthly.txt"))
lines = lines.Distinct().ToArray()
IO.File.WriteAllLines(Path.Combine(Environment.GetFolderPath(Environment.SpecialFolder.MyDocuments), "Horoscope", "Monthly.txt"), lines)
Is there another way that I can get the same affect of having a gap inbetween my quotes in a text file?
When removing the duplicates, you can drop the existing blank lines with Where, then add them back into the lines array using SelectMany:
lines = lines.
Where(Function(x) Not String.IsNullOrEmpty(x)).
Distinct().
SelectMany(Function(x) { x, String.Empty }).
ToArray()
The SelectMany returns the line, plus a blank, for each line left after the Distinct.
You may also want to use File.AppendAllLines when adding new entries - seems a little cleaner:
File.AppendAllLines(fileName, { Chr(34) & finish & Chr(34), ""})
EDIT
This would fit in with your code something like this:
If Not div Is Nothing Then
Dim finish As String = (div.InnerText.Trim())
TextBox2.Text = Chr(34) & finish & Chr(34)
Dim fileName As String = Path.Combine(Environment.GetFolderPath(Environment.SpecialFolder.MyDocuments), "Horoscope", "Monthly.txt")
IO.File.AppendAllLines(fileName, { Chr(34) & finish & Chr(34), ""})
End If
'...
Dim lines As String() = IO.File.ReadAllLines(Path.Combine(Environment.GetFolderPath(Environment.SpecialFolder.MyDocuments), "Horoscope", "Monthly.txt"))
lines = lines.
Where(Function(x) Not String.IsNullOrEmpty(x)).
Distinct().
SelectMany(Function(x) { x, String.Empty }).
ToArray()
IO.File.WriteAllLines(Path.Combine(Environment.GetFolderPath(Environment.SpecialFolder.MyDocuments), "Horoscope", "Monthly.txt"), lines)
This has been bugging me for a week and i do not see any other way. We have only been taught record data structures which is basic, FileOpen, WriteLine and etc. but i read MSDN and StreamWriter/Reader looks much more promising. This is an assignment/coursework and its essential for practically all parts of the program.
All i want to do is read line by line separating fields by a comma and define it as a variable. It would also help to be able to read the line without the quotes "", because right now when i read a password out with LineInput it reads it entirely "pass".
Private Sub StudentLogin()
Dim Filename As New StreamWriter("" & Register.StudentDirectory & "" & Username & ".txt")
Dim str As String = "This"
Dim lines() As String = str.Split(New String() {Environment.NewLine}, StringSplitOptions.None)
For Each line As String In lines
Dim columns() As String = line.Split(","c)
Firstname = columns(0)
Surname = columns(1)
Password = columns(2)
ClassID = columns(3)
Next
MessageBox.Show("" & ClassID & " " & Password & "")
End Sub
Text file:
"cem","polat","pass","class"
I just want to read the file - then each line, row by row, defining each column field which is in C:/Spellcheck/data/accounts/students/+filename+ and define a few variables.
This is going to be a long one, but easy fix.
So i've manage to convert a pdf to string, then able to print an external pdf simply by putting the name of the file in a textbox.
I've also figured how to extract certain text from the pdf string, now the certain text are also files located in an external location (I use c:\temp\ for testing).
Which leaves me with one problem, the text I extract, I use shellexecute to print, works fine if its one string. however, If the file name I extract is more than one it will count it as a single string, thus adding the location and .pdf to that one string. instead of the two or more strings. which will do something like this:
As you can see, it will send that to the printer. I want to send one at a time to the printer. like this:
I've tried using an Arraylist and various methods. but my own lack of knowledge, I cannot figure it out.
I'm thinking a "for loop" will help me out. any ideas?
Below is my code.
Dim pdffilename As String = Nothing
pdffilename = RawTextbox.Text
Dim filepath = "c:\temp\" & RawTextbox.Text & ".pdf"
Dim thetext As String
thetext = GetTextFromPDF(filepath) ' converts pdf to text from a function I didnt show.
Dim re As New Regex("[\t ](?<w>((asm)|(asy)|(717)|(ssm)|(715)|(818))[a-z0-9]*)[\t ]", RegexOptions.ExplicitCapture Or RegexOptions.IgnoreCase Or RegexOptions.Compiled) ' This filters out and extract certain keywords from the PDF
Dim Lines() As String = {thetext}
Dim words As New List(Of String)
For Each s As String In Lines
Dim mc As MatchCollection = re.Matches(s)
For Each m As Match In mc
words.Add(m.Groups("w").Value)
Next
RawRich4.Text = String.Join(Environment.NewLine, words.ToArray)
Next
'This is where I need help with the code. how to have "words" putout "c:\temp\" & RawRich4.Text & ".pdf" with each keyword name
Dim rawtoprint As String = String.Join(Environment.NewLine, words.ToArray)
Dim defname As String = Nothing
defname = RawRich4.Text
rawtoprint = "c:\temp\" & RawRich4.Text & ".pdf"
Dim psi As New System.Diagnostics.ProcessStartInfo()
psi.UseShellExecute = True
psi.Verb = "print"
psi.WindowStyle = ProcessWindowStyle.Hidden
psi.Arguments = PrintDialog1.PrinterSettings.PrinterName.ToString()
psi.FileName = (rawtoprint) ' this is where the error occurs it doesn't send both files separately to the printer, it tries to send it as one name
MessageBox.Show(rawtoprint) ' This is just to test the output, this will be removed.
'Process.Start(psi)
End Sub
Updated.
Imports System.Text.RegularExpressions
Module Program
Sub Main()
Dim pdffilename As String = RawTextbox.Text
Dim filepath = "c:\temp\" & RawTextbox.Text & ".pdf"
Dim thetext As String
thetext = GetTextFromPDF(filepath) ' converts pdf to text from a function I didnt show.
'thetext = "Random text here and everywhere ASM00200207 1 1 same here bah boom 12303 doh hel232 ASM00200208 1 2 "
Dim pattern As String = "(?i)[\t ](?<w>((asm)|(asy)|(717)|(ssm)|(715)|(818))[a-z0-9]*)[\t ]"
For Each m As Match In rgx.Matches(thetext, pattern)
'Console.WriteLine("C:\temp\" & Trim(m.ToString) & ".pdf")
RawPrintFunction("C:\temp\" & Trim(m.ToString) & ".pdf")
Next
End Sub
Function RawPrintFunction(ByVal rawtoprint As String) As Integer
Dim psi As New System.Diagnostics.ProcessStartInfo()
psi.UseShellExecute = True
psi.Verb = "print"
psi.WindowStyle = ProcessWindowStyle.Hidden
psi.Arguments = PrintDialog1.PrinterSettings.PrinterName.ToString()
MessageBox.Show(rawtoprint) This will be removed, this is just for testing to see what files will be printed
'Process.Start(psi) This will be uncomment.
return 0
End Function
End Module
If I don't misunderstand the code -since I can't test and run it here- you can iterate through file names stored in words variable and send it to printer. Following is an example on how to do that :
....
....
Dim Lines() As String = {thetext}
Dim words As New List(Of String)
For Each s As String In Lines
Dim mc As MatchCollection = re.Matches(s)
For Each m As Match In mc
words.Add(m.Groups("w").Value)
Next
RawRich4.Text = String.Join(Environment.NewLine, words.ToArray)
Next
For Each fileName As String In words
Dim rawtoprint As String
rawtoprint = "c:\temp\" & fileName & ".pdf"
Dim psi As New System.Diagnostics.ProcessStartInfo()
psi.UseShellExecute = True
psi.Verb = "print"
psi.WindowStyle = ProcessWindowStyle.Hidden
psi.Arguments = PrintDialog1.PrinterSettings.PrinterName.ToString()
psi.FileName = (rawtoprint) ' this is where the error occurs it doesn't send both files separately to the printer, it tries to send it as one name
MessageBox.Show(rawtoprint) ' This is just to test the output, this will be removed.
'Process.Start(psi)
Next
Lets say i have this in a shell
"chdir * && whoami.exe >> $$$"
I have this replacecommand
Dim ReplaceCommand as String = sCommand.Replace("*", UserDirect)
I also would like the $$$ to be replaced with a user chosen filepath.
I can get the file path chosen but it never puts it into the shell.
I have tried
Dim ReplaceCommand1, ReplaceCommand2 as String = sCommand.Replace("*" & "$$$", UserDirect & filepath)
Shell("cmd.exe" & ReplaceCommand1 & ReplaceCommand2)
Dim ReplaceCommand as String = sCommand.Replace("*", UserDirect) & ("$$$", filepath)
Shell("cmd.exe" & ReplaceCommand)
also
Dim ReplaceCommand1 as String = sCommand.Replace("*", UserDirect)
Dim ReplaceCommand2 as String = sCommand.Replace("$$$", filepath)
Shell("cmd.exe" & ReplaceCommand1 & ReplaceCommand2)
EDIT:
get a path to short error when I use commas in shell instead of &
Dim ReplaceCommand1 as String = sCommand.Replace("*", UserDirect)
Dim ReplaceCommand2 as String = sCommand.Replace("$$$", filepath)
Shell("cmd.exe", ReplaceCommand1 , ReplaceCommand2)
You can chain the Replace's together:
Dim ReplaceCommand1 as String = sCommand.Replace("*", UserDirect).Replace("$$$", filepath)
Shell("cmd.exe" & ReplaceCommand1)
Part of your examples don't compile cause of the syntax errors.
You're not using Shell() like you're supposed to.
Public Function Shell(
PathName As String,
Optional Style As Microsoft.VisualBasic.AppWinStyle = MinimizedFocus,
Optional Wait As Boolean = False,
Optional Timeout As Integer = -1
) As Integer
From the examples you gave, it looks like you're just throwing stuff together. Stop and think for a minute :)