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
Related
JavaError.128 = "project creation failed. & vbLf & Please try again and if the problem persists then contact the administrator"
I am able to read this message from text file. the issue is vbLf is not considered as newline in msgbox. it prints vbLf in msgbox.
Using sr As System.IO.StreamReader = My.Computer.FileSystem.OpenTextFileReader(errorfilePath)
While ((sr.Peek() <> -1))
line = sr.ReadLine
If line.Trim().StartsWith("JavaError." & output) Then
isValueFound = True
Exit While
End If
End While
sr.Close()
End Using
If isValueFound Then
Dim strArray As String() = line.Split("="c)
MsgBox(strArray(1).Replace("""", "").Trim({" "c}))
End If
You can make all your code a simpler one line version using File.ReadAllLines and LINQ. This code will put all the lines starting with javaerror into the textbox, not just the first:
textBox.Lines = File.ReadAllLines(errorFilePath) _
.Where(Function(s) s.Trim().StartsWith("JavaError")) _
.Select(Function(t) t.Substring(t.IndexOf("= ") + 2).Replace(" & vbLf & ", Environment.NewLine)) _
.ToArray()
You need to Imports System.IO and System.Linq
This code reads all the lines of the file into an array, then uses LINQ to pull out only those starting with java error, then projects a new string of everything after the = with vbLf replaced with a newline, converts the enumerable projection to an array of strings and assigns it to the textBox lines
If you don't want all the lines but instead only the first:
textBox.Text = File.ReadLines(errorFilePath) _
.FirstOrDefault(Function(s) s.Trim().StartsWith("JavaError")) _
?.Substring(t.IndexOf("= ") + 2).Replace(" & vbLf & ", Environment.NewLine))
This one uses ReadLine instead of ReadALlLines - ReadLines works progressively, and it makes sense to be able to stop reading after we foundt he first rather than have the overhead of reading ALL (million) lines only to then end up pulling the first out and throwing 999,999 lines of effort away. So it's reading line by line, pulls out the first that starts with "JavaError" (or Nothing if there is no such line), then checks if Nothing came out (the ?) and skips the Substring if it was Nothing, or it does a Substring on everything after the = and replaces vbLf with newline
For a straight up mod of your original code:
Using sr As System.IO.StreamReader = My.Computer.FileSystem.OpenTextFileReader(errorfilePath)
While ((sr.Peek() <> -1))
line = sr.ReadLine
If line.Trim().StartsWith("JavaError." & output) Then
isValueFound = True
line = line.Replace(" & vbLf & ", Environment.NewLine))
'^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ added code
Exit While
End If
End While
sr.Close()
End Using
If isValueFound Then
Dim strArray As String() = line.Split("="c)
MsgBox(strArray(1).Replace("""", "").Trim({" "c}))
End If
Note that I've always made my replacement on & vbLf & with a space at each end to avoid stray spaces being left behind - if your file sometimes doesn't have them, consider using Regex to do the replace, e.g. Regex.Replace(line, " ?& vbLf & ?", Environment.NewLine
This could work:
Dim txtFile As String = "project creation failed. & vbLf & Please try again and if the problem persists then contact the administrator"
Dim arraytext() As String = txtFile.Split("&")
Dim txtMsgBox As String = Nothing
For Each row As String In arraytext
If Trim(row) = "vbLf" Then
txtMsgBox = txtMsgBox & vbLf
Else
txtMsgBox = txtMsgBox & Trim(row)
End If
Next
MsgBox(txtMsgBox)
I have a long text field (called "reporttext") that someone is importing a bunch of text that needs to be separated and appended into another table. For each case, there's a "[]" character that is supposed to separate each case. I want my code to look for the first [] and second [], append the text to another table and then loop. So the next case would be the text between the second [] and third [].
Here's my string
Reporttext: [] ksfjjls [] 42244 [] ####
I would want this to append to a new table called "notes" where it would be like this:
Reporttext
ksfjjls
42244
####
I used a macro to count the number of [] in the text file to know how many times to run the loop, but this, along with the rest of my code just isn't happening. I know my code is wrong, but I know with a few tweaks it'll get there. Any help is appreciated.
lengthofnote = Len([reporttext])
start = InStr([reporttext], "[]")
startplus3 = [start] + 3
'find number of cases
firstcase = 1
numcases = StringCountOccurrences([reporttext], "[]")
Dim LCounter As Integer
For LCounter = [firstcase] To [numcases]
revisedreporttext = Mid([reporttext], [startplus3], [lengthofnote])
secondposition = InStr([revisedreporttext], "[]")
nextreporttext = Mid([reporttext], [startplus3], [secondposition])
Add_reporttext = "INSERT INTO notes(reporttext) values ('" & nextreporttext & "');"
DoCmd.RunSQL Add_reporttext
firstcase = firstcase + 1
startplus3 = secondposition
secondposition = secondposition + 4
Next LCounter
#Zev Spitz is correct in that you could use Split() to accomplish this. You could use something like this
Option Compare Database
Option Explicit
Sub SplitLongTextField()
Dim rs As Recordset
Dim reportTextArr
Dim qString As String
Dim i As Long
qString = "SELECT [reporttext] FROM [Table1]" '<- replace [Table1] with the name of your table with the Long Text field
Set rs = CurrentDb.OpenRecordset(qString)
If Not rs.EOF Then
reportTextArr = Split(rs.Fields("reporttext"), "[]")
End If
For i = LBound(reportTextArr) To UBound(reportTextArr)
If Not reportTextArr(i) = "" Then
DoCmd.RunSQL "INSERT INTO notes(reporttext) VALUES('" & reportTextArr(i) & "');"
End If
Next i
rs.Close
End Sub
If you needed to do this for multiple records from your initial table then you could loop through the entire table and loop the operation like
Option Compare Database
Option Explicit
Sub SplitLongTextField()
Dim rs As Recordset
Dim reportTextArr
Dim qString As String
Dim i As Long
qString = "SELECT [reporttext] FROM [Table1]" '<- replace [Table1] with the name of your table with the Long Text field
Set rs = CurrentDb.OpenRecordset(qString)
Do Until rs.EOF
reportTextArr = Split(rs.Fields("reporttext"), "[]")
For i = LBound(reportTextArr) To UBound(reportTextArr)
If Not reportTextArr(i) = "" Then
DoCmd.RunSQL "INSERT INTO notes(reporttext) VALUES('" & reportTextArr(i) & "');"
End If
Next i
rs.MoveNext
Loop
rs.Close
End Sub
Assuming the string always starts with [] and preference is to return a single string, consider:
Replace(Mid(reporttext, 4), "[] ", vbCrLf)
I'm trying to import an SQL file into excel via VBA in order to return the SQL code as one string, however I'm getting tiny squares (carriage returns?) between each character when I import the SQL as a string - not a clue why! It's worked before in other files, with different SQL, so I'm not sure what I've done wrong.
Function ImportSQLText(FileExt, FileSQLName)
'//Needs Microsoft Scripting Runtime Ref
'//and microsoft active x data objects 2.8
Dim ReadText As String, newLine As String
Dim fso As FileSystemObject: Set fso = New FileSystemObject
Set txtStream = fso.OpenTextFile(FileExt & fileName, ForReading, False)
ReadText = " "
Do While Not txtStream.AtEndOfStream
newLine = txtStream.ReadLine
If InStr(newLine, "[input-sDte]") > 0 Then
ReadText = ReadText & Replace(newLine, "[input-sDte]", sDte) & vbCrLf
ElseIf InStr(newLine, "[input-eDte]") > 0 Then
ReadText = ReadText & Replace(newLine, "[input-eDte]", eDte) & vbCrLf
Else
ReadText = ReadText & newLine & vbCrLf
End If
Loop
txtStream.Close
ImportSQLText = ReadText
End Function
The SQL code looks like:
;if object_id('tempdb.#usr_fld') is not null
drop table #usr_fld
-- Creating Temp Table
CREATE TABLE #usr_fld([PLACE-REF] NVARCHAR(50)
,[PROJCODE] nvarchar(100)
,[CUORACLE] nvarchar(100));
Any input would be greatly appreciated - googling it is not helping me this time.
You almost definitely have a unicode file. There is an optional fourth parameter on the OpenTextfile method of FSO:
Const TriStateTrue = -1
Set txtStream = fso.OpenTextFile(FileExt & fileName, ForReading, False, TriStateTrue)
Just swap out your line for these two and it might fix the issue.
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.
I have to document an MS Access database with many many macros queries, etc. I wish to use code to extract each SQL query to a file which is named the same as the query, eg if a query is named q_warehouse_issues then i wish to extract the SQL to a file named q_warehouse_issues.sql
I DO NOT WISH TO EXPORT THE QUERY RESULT SET, JUST THE SQL!
I know I can do this manually in Access, but i am tired of all the clicking, doing saveas etc.
This should get you started:
Dim db As DAO.Database
Dim qdf As DAO.QueryDef
Set db = CurrentDB()
For Each qdf In db.QueryDefs
Debug.Print qdf.SQL
Next qdf
Set qdf = Nothing
Set db = Nothing
You can use the File System Object or the built-in VBA File I/O features to write the SQL out to a file. I assume you were asking more about how to get the SQL than you were about how to write out the file, but if you need that, say so in a comment and I'll edit the post (or someone will post their own answer with instructions for that).
Hope this helps.
Public Function query_print()
Dim db As Database
Dim qr As QueryDef
Set db = CurrentDb
For Each qr In db.QueryDefs
TextOut (qr.Name)
TextOut (qr.SQL)
TextOut (String(100, "-"))
Next
End Function
Public Sub TextOut(OutputString As String)
Dim fh As Long
fh = FreeFile
Open "c:\File.txt" For Append As fh
Print #fh, OutputString
Close fh
End Sub
This solution include fields in query
Public Sub ListQueries()
' Author: Date: Contact:
' André Bernardes 09/09/2010 08:45 bernardess#gmail.com http://al-bernardes.sites.uol.com.br/
' Lista todas as queries da aplicação.
' Listening:
Dim i As Integer
Dim j As Integer
Dim k As Integer
Dim l As Integer
On Error Resume Next
For i = 0 To CurrentDb.QueryDefs.Count - 1
Debug.Print "Query: " & CurrentDb.QueryDefs(i).Name
For j = 0 To CurrentDb.QueryDefs(i).Fields.Count - 1
Debug.Print "Field " & CurrentDb.QueryDefs(i).Fields(j).Name
Next
Debug.Print " SQL: " & CurrentDb.QueryDefs(i).SQL
Next
End Sub
In the VB Window, click Tools->References....
In the References window add the dependency Microsoft Scripting Runtime by checking it off.
Then this code will export the queries to a file suitable for using grep on:
Sub ExportQueries()
Dim fso As New FileSystemObject
Dim stream As TextStream
Set stream = fso.CreateTextFile("e:\temp\queries.txt")
Dim db As DAO.Database
Dim qdf As DAO.QueryDef
Set db = CurrentDb()
For Each qdf In db.QueryDefs
stream.writeline "Name: " & qdf.Name
stream.writeline qdf.SQL
stream.writeline "--------------------------"
Next qdf
Set qdf = Nothing
Set db = Nothing
End Sub
I modified #andre-bernardes's code to use
"|" separators before the query names
and ":" separators before the SQL statements.
The different separators make it easier to parse the Queries.txt file with python and create a dictionnary of queries and SQL statements.
You can then use this dictionary to create views in an SQLite table for example.
VBA code to extract the SQL queries
Public Sub ListQueries()
' Modified from André Bernardes
Dim i As Integer
Dim ff As Long
ff = FreeFile()
Open "C:\Dev\Queries.txt" For Output As #ff
On Error Resume Next
For i = 0 To CurrentDb.QueryDefs.Count - 1
Debug.Print "|" & CurrentDb.QueryDefs(i).Name & ":"
Print #ff, "|" & CurrentDb.QueryDefs(i).Name & ":"
Debug.Print CurrentDb.QueryDefs(i).SQL
Print #ff, CurrentDb.QueryDefs(i).SQL
Next
End Sub
Python code to parse Queries.txt into a dictionary
queries_file = open(data_path + '/Queries.txt')
queries = queries_file.read().split('|')
l = [x.split(':') for x in queries]
l.pop(0)
table_name_to_query = {name: query for name, query in l}
Create SQLite views from the Access queries
import sqlite3
conn = sqlite3.connect('example.db')
c = conn.cursor()
for table, query in table_name_to_query.items():
try:
c.execute("CREATE VIEW `%s` AS %s" % (table,query))
print("\n\n"+ table + " passed")
print(query)
except Exception as e:
print("\n\n"+ table + " error")
print(e)
print(query)