I am trying to append a CSV's last row and allow it to be read by a C# user control.
The reason we have to do that way is because the data become available at two different times.
It works fine except for the following:
It generates an empty line after appending.
After repeating it for 3-4 steps it deletes the whole file.
The code is below:
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objInFile = objFSO.OpenTextFile("R:\cat3_data.csv", 1)
strContents = objInFile.ReadAll
objInFile.Close
arrRows = Split(strContents, vbNewLine)
MsgBox UBound(arrRows)
arrRows(UBound(arrRows) - 1) = arrRows(UBound(arrRows) - 1) & "," & "Hi" & _
"," & "Hi" & "," & "Hi" & "," & "Hi" & "," & "Hi"
strContents = Join(arrRows, vbNewLine)
Set objOutFile = objFSO.OpenTextFile("R:\cat3_data.csv", 2)
objOutFile.WriteLine strContents
objOutFile.Close
Set objFSO = Nothing
Related
Very new to SwiftUI and reading data from JSON files, but getting there. Could experts in the community advise please how I get from the data in Excel to the format required in JSON.
In Excel I have this...
... and what I would like from that data in Excel is for my JSON file to be like this...
Could someone advise the steps I'd need to take to get from a to b please. Wondering if this can be done in one step, or if it has to be multiple.
Essentially the code I am writing needs to select 'n' questions from each SylabusItem. So in this example, Question 1 in the exam would need 2 questions presented to the student from a selection of those with the same SylabusItem. So, in this case 2 from 3. Subsequent questions will vary of course.
Thoughts?
Thanks.
You could do that in one step with a VBA function easily enough.
dim dataToWrite(0) 'Normally, I'd dim this as dataToWrite() then use a function to ascertain if empty or not, then either redim(0) or redim preserve (ubound+1) on down. But for succintness just ignoring that.
'Get the lastRow of your data
sheetName1 = activesheet.name 'Obviously change that to whatever suits
LastRow = Sheets(sheetName1).Cells(Sheets(sheetName1).Rows.Count, "A").End(xlUp).Row
for iRow = 2 to lastRow 'Assuming that you have header sheet in first row
if not isempty(Sheets(sheetName1).cells(iRow,1)) then
'Have a Qn entry here
redim preserve dataToWrite(ubound(dataToWrite)+1)
'Do our prefixing
dataToWrite(ubound(dataToWrite)) = "["
redim preserve dataToWrite(ubound(dataToWrite)+1)
dataToWrite(ubound(dataToWrite)) = vbTab & "{"
redim preserve dataToWrite(ubound(dataToWrite)+1)
dataToWrite(ubound(dataToWrite)) = vbTab & vbTab & vbTab & """"Qn"""" & ":" & """" & Sheets(sheetName1).cells(iRow,1) & """"
redim preserve dataToWrite(ubound(dataToWrite)+1)
dataToWrite(ubound(dataToWrite)) = vbTab & vbTab vbTab & & """" & "Level" & """" & ":" & """" & Sheets(sheetName1).cells(iRow,2) & """"
'etc, over to answers, then
corrAnswer = -1
DoUntil IsEmpty(Sheets(sheetName1).cells(iRow,5))
redim preserve dataToWrite(ubound(dataToWrite)+1)
dataToWrite(ubound(dataToWrite)) = vbTab & vbTab & vbTab & """" & "Answer" & Sheets(sheetName1).cells(iRow,5) & """" & ":" & """" & Sheets(sheetName1).cells(iRow,6) & """"
if Sheets(sheetName1).cells(iRow,7) = "y" then
corrAnswer = Sheets(sheetName1).cells(iRow,5)
iRow = iRow + 1
Loop
if corrAnswer = -1 then
'We didn't find a correct answer, problem
else
redim preserve dataToWrite(ubound(dataToWrite)+1)
dataToWrite(ubound(dataToWrite)) = vbTab & vbTab & vbTab & """" & "CorrectAnswer" & """" & ":" & """" & corrAnswer & """"
end if
'And close out
redim preserve dataToWrite(ubound(dataToWrite)+1)
dataToWrite(ubound(dataToWrite)) = vbTab & "},"
next iRow
'Then write out dataToWrite to your text (json) file
Dim filePath As String
filePath = "C:\temp\MyTestFile.txt"
Dim fso As FileSystemObject
Set fso = New FileSystemObject
Dim fileStream As TextStream
Set fileStream = fso.CreateTextFile(filePath)
for iLine = 0 to ubound(dataToWrite)
fileStream.WriteLine dataToWrite(iLine)
fileStream.Close
Thats not complete obviously, and something I've just scribbled down on this page so untested - and likely to have some pythonic stuff in by accident. But should be the bare bones of what you are looking for.
Sorry - forgot your looking the indents. Apply a suitable number of vbTab to the string line,
I want to export a query as a text file from an access database but using vba. The issue is I need to save it with .ail2 in the name.
basically I want it of the form: "currentdate_version.ail2".txt (the quotations are very important otherwise it won't work).
So for example todays first version would look like:
"20182910_1.ail2".txt
I have tried exporting it manually and saving it as this but the export wizard doesn't seem to like the quotation marks in the saved name. I have therefore been exporting it (using a custom saved export that i've labelled test1 - it includes the headers of each column, sets the text qualifier as 'none', the field delimiter as 'tab' and file format is 'delimited').
I am using the following code in access, the first part just makes sure the folder with the current date exists.
Private Sub ExportExcel()
Dim myQueryName As String
Dim myExportFileName As String
Dim strSheets As String
Dim sFolderPath As String
Dim filename As Variant
Dim i As Integer
strSheets = Format(Date, "yyyymmdd")
sFolderPath = "M:\AIL2Files\" & strSheets & ""
Dim fdObj As Object
Set fdObj = CreateObject("Scripting.FileSystemObject")
If fdObj.FolderExists("" & sFolderPath & "") Then
Else
fdObj.CreateFolder ("" & sFolderPath & "")
End If
i = 1
filename = Dir(sFolderPath & "\*" & i & ".txt")
Do While Len(filename) > 0
filename = Dir(sFolderPath & "\*" & i & ".txt")
i = i + 1
Loop
myQueryName = "001_querytest"
myExportFileName = "" & sFolderPath & "\" & Chr(34) & "" & strSheets & "_" & i & ".ail2" & Chr(34) & ".txt"
DoCmd.TransferText acExportDelim, "test1", myQueryName, myExportFileName, True
End Sub
test1 isn't being picked up even though its a 'saved export'. I assume I'm doing this part wrong... but even still I reckon the save won't be successful and will not include the quotation marks.
Thanks.
EDIT:
I have tried doing the following instead:
DoCmd.TransferText transferType:=acExportDelim, TableName:=myQueryName, filename:=myExportFileName, hasfieldnames:=True
It now saves, but again not including the quotation marks as desired. Whats interesting is when I type ?myExportFileName in the immediate window, it displays my desired filename but the command is clearly not working correctly as I get it of the form:
_20181029_1#ail2_
Instead...
Here is image if I use save as:
I end up getting:
There are some misconceptions here.
Windows file names cannot contain double quotes ", period. And you don't need them, either. Just save your file as filename.ail2.
This is what you get when doing "Save as". Tell Explorer to show file extensions, and you'll see that you don't have "filename.ail2".txt but filename.ail2.
You only need
myExportFileName = sFolderPath & "\" & strSheets & "_" & i & ".ail2"
test1 isn't being picked up even though its a 'saved export'.
DoCmd.TransferText doesn't use saved exports, but export specifications. See here for the difference:
Can I programmatically get at all Import/Export Specs in MS Access 2010?
Addendum
DoCmd.TransferText could throw a runtime error when given an illegal file name, but apparently it tries to save the day by exchanging the illegal characters by _, hence _20181029_1#ail2_ (.txt)
A workaround to this is first saving the file as a .txt using DoCmd.TransferText, but running a shell and renaming. Like such:
myExportFileName = sFolderPath & "\" & strSheets & "_" & i & ".txt"
DoCmd.TransferText TransferType:=acExportDelim, SpecificationName:="034_AILFILE Export Specification", TableName:=myQueryName, filename:=myExportFileName, HasFieldnames:=True
Set wshShell = CreateObject("Wscript.Shell")
strDocuments = wshShell.SpecialFolders("M:\AIL2Files\" & strSheets & "")
oldFileName = myExportFileName
newFileName = sFolderPath & "\" & strSheets & "_" & i & ".ail2"
Name oldFileName As newFileName
There is undoubtedly cleaner ways of doing this but I imagine that this method could be used to save any files that have non traditional extensions, but fundamentally follow the format of a .txt file.
I am attempting to read a text file that contains rows and then output them in the form of columns in an html file. I have no problem having this work when using WScript.echo to display it on the screen, but I am unable to get it to a table in an HTML file. I am getting the following error when attempting to run the vbs file: Type mismatch: 'OpenTextFile'. Any guidance would be much appreciated
Dim fso : Set fso = CreateObject("Scripting.FileSystemObject")
Dim OutputHTML : Set OutputHTML = fso.CreateTextFile("C:\Users\Istaley.RXDATA\Desktop\NewEmployeeTest\Part2_TableData.html")
Dim file : Set file = fso.OpenTextFile("C:\Users\Istaley.RXDATA\Desktop\NewEmployeeTest\Part2_data.txt", 1, True)
Dim fc : fc = file.ReadAll : file.close : Dim fcArray : fcArray = Split(fc, vbCrLf)
OutputHTML.WriteLine "<html>"
OutputHTML.Writeline "<body>"
OutputHTML.WriteLine "<table BORDER=1>"
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
OutputHTML.WriteLine "<tr>"
opArray(ent) = opArray(ent) & " " & Trim(tmp(ent))
OutputHTML.WriteLine "</tr>"
Else
opArray(ent) = Trim(tmp(ent))
End If
End If
Next
Next
WScript.echo Join(opArray, vbCrLf)
OutputHTML.WriteLine "</table>"
OutputHTML.WriteLine "</body>"
OutputHTML.WriteLine "</html>"
OutputHTML.Write Join(opArray, vbCrLf) : OutputHTML.Close
I know it's an old topic, but this might be useful to anyone looking to do the same, like I did. It's a bit rushed, but I've added comments inline. Bits have been taken from a number of locations, so it's not all my own work...
Function LoadFile(File)
On Error Resume Next
'Declaire all variables
Dim fso,F,ReadText,strError
Dim ReadArray
Dim ReadHTMLOutput, ReadRowCount, ReadRowItem, ReadRowItemSplit, ReadElementCount, ReadElementItem
'Create the object to read files
Set fso = CreateObject("Scripting.FileSystemObject")
'Set the file to read and the format
Set F = fso.OpenTextFile(File,1)
'If there's a problem, say so...
If Err.Number <> 0 Then
strError = "<center><b><font color=Red>The file "& File &" dosen't exists !</font></b></center>"
OutputTable.InnerHTML = strError
Exit Function
End If
'Read the contents of the file into ReadText
ReadText = F.ReadAll
'Split the text based on Carriage return / Line feed
ReadArray = Split(ReadText,vbCrLf)
'fill the output variable with the HTML of the start of the table
ReadHTMLOutput = "<table border=" & chr(34) & "2" & chr(34) & ">" & vbcrlf
'starting at 0 until the last line in the array, run through each line
For ReadRowCount=0 to UBound(ReadArray)
'Take the whole row into it's own variable
ReadRowItem = ReadArray(ReadRowCount)
'Split the row (separated by commas) into an array
ReadRowItemSplit = Split(ReadRowItem,",")
'Add the HTML for the row of the table
ReadHTMLOutput = ReadHTMLOutput & "<tr>" & vbcrlf
'starting at 0 until the last entry of the row array, run through each element
For ReadElementCount=0 to UBound(ReadRowItemSplit)
'Read the element into a variable
ReadElementItem = ReadRowItemSplit(ReadElementCount)
'If the element is blank, put a space in (stops the cell being formatted empty)
If ReadElementItem = "" Then ReadElementItem = " "
'Add the HTML for the cell of the row of the table
ReadHTMLOutput = ReadHTMLOutput & "<td>" & ReadElementItem & "</td>" & vbcrlf
'Go to the next element in the row
Next
'Add the HTML for the end of the row of the table
ReadHTMLOutput = ReadHTMLOutput & "</tr>" & vbcrlf
'Go to the next row in the file
Next
'Add the HTML for the end of the table
ReadHTMLOutput = ReadHTMLOutput & "</table>" & vbcrlf
'Fill the DIV with the contents of the variable
OutputTable.InnerHTML = ReadHTMLOutput
End Function
and in the HTML:
<div id="OutputTable"></div>
That way, the DIV is filled with the HTML from ReadHTMLOutput
The issue is this line.. The first argument of OpenTextFile takes a string, but you have passed it an Object. You've already opened the text file for writing using CreateTextFile.
Set WriteOutput = fso.OpenTextFile(OutputHTML, 8, True)
Get rid of this line and change all remaining instances of WriteOutput to OutputHTML.
I have code that will list tables names, how can I export this to a text file?
For Each tbl In db.TableDefs
If Left$(tbl.Name, 4) <> "MSys" Then
Debug.Print tbl.Name & " " & tbl.DateCreated & " " & _
tbl.LastUpdated & " " & tbl.RecordCount
See the MSDN article on how to create a text file:
http://msdn.microsoft.com/en-us/library/aa265018(v=vs.60).aspx
Modified slightly for your needs, you will have to tweak it to define db and TableDefs etc:
Sub CreateAfile
Dim fs as Object, a as Object
Dim lineText as String
#Create and open text file for writing:
Set fs = CreateObject("Scripting.FileSystemObject")
Set a = fs.CreateTextFile("c:\testfile.txt", True)
'#Iterate over your TableDefs
For Each tbl In db.TableDefs
If Left$(tbl.Name, 4) <> "MSys" Then
lineText = tbl.Name & " " & tbl.DateCreated & " " & _
tbl.LastUpdated & " " & tbl.RecordCount
'# Adds a line to the text file
a.WriteLine(lineText)
End If
Next
'#Close the textfile
a.Close
End Sub
You can use simple File I/O to write to a textfile. MSDN: Write# Statement
Here is the example from that page:
Open "TESTFILE" For Output As #1 ' Open file for output.
Write #1, "Hello World", 234 ' Write comma-delimited data.
Write #1, ' Write blank line.
Dim MyBool, MyDate, MyNull, MyError
' Assign Boolean, Date, Null, and Error values.
MyBool = False: MyDate = #2/12/1969#: MyNull = Null
MyError = CVErr(32767)
' Boolean data is written as #TRUE# or #FALSE#. Date literals are
' written in universal date format, for example, #1994-07-13#
'represents July 13, 1994. Null data is written as #NULL#.
' Error data is written as #ERROR errorcode#.
Write #1, MyBool; " is a Boolean value"
Write #1, MyDate; " is a date"
Write #1, MyNull; " is a null value"
Write #1, MyError; " is an error value"
Close #1 ' Close file.
Change the file name, and extension, to, for example, "C:\SomeFolder\myfile.txt".
There are other, more sophisticated, ways to do this, including using the FileSystemObject as shown in the link David provided.
This will work as a straight copy/paste. Just change the output file name to whatever you want. It outputs the metadata you requested line by line toa .txt
Dim db As DAO.Database
Set db = CurrentDb
Dim filename As String
filename = "C:\Users\Scotch\Desktop\now\t.txt" 'add your file name here
Const ForReading = 1, ForWriting = 2, ForAppending = 3
Const TristateUseDefault = -2, TristateTrue = -1, TristateFalse = 0
Dim fs, f, ts, s
Set fs = CreateObject("Scripting.FileSystemObject")
fs.CreateTextFile filename 'Create a file
Set f = fs.GetFile(filename)
Set ts = f.OpenAsTextStream(ForWriting, TristateUseDefault)
For Each tbl In db.TableDefs
If Left$(tbl.name, 4) <> "MSys" Then
ts.Write tbl.name & " " & tbl.DateCreated & " " & _
tbl.LastUpdated & " " & tbl.RecordCount & vbNewLine
End If
Next
ts.Close
Finally the administrator configured the IIS for me the error message is listed below.
Set SQLStream = CreateObject("ADODB.Stream")
Set SQLConnection = CreateObject("ADODB.Connection")
Set SQLCommand = CreateObject("ADODB.Command")
Set SQLRecordSet = CreateObject("ADODB.RecordSet")
SQLConnection.Open "Provider=sqloledb;SERVER=SQLPROD;DATABASE=MyDataBase;UID=MyUsername;PWDMyPassword;"
'Response.Write("Connection Status: " & SQLConnection.State) & vbnewline
'Response.Write("Connection Provider: " & SQLConnection.Provider) & vbnewline
'Response.Write("Version: " & SQLConnection.Version) & vbnewline
SQLCommand.ActiveConnection = SQLConnection
SQLCommand.CommandText = "SELECT Seminars.Year, Seminars.SeminarID, Seminars.Theme, Seminar_Week.First, Seminar_Week.Last, Seminar_Week.WeekID, Seminar_Week.Date, Seminar_Week.Affiliation FROM Seminars CROSS JOIN Seminar_Week"
'Response.Write("SQL Command Passed in: " & SQLCommand.CommandText)
Set adoRec = SQLCommand.Execute()
file1 = "./seminars/" & seminar_type & "/" & seminar_year & "/" & adoRec("Date") & "-" & adoRec("Year") & "_" & adoRec("Last") & ".pdf"
file2 = "./seminars/" & seminar_type & "/" & seminar_year & "/" & adoRec("Date") & "-" & seminar_year & "_" & adoRec("Last") & "(handouts).pdf"
file3 = "./seminars/" & seminar_type & "/" & seminar_year & "/" & adoRec("Date") & "-" & seminar_year & "_" & adoRec("Last") & "_Flyer.pdf"
Set fso = CreateObject("scripting.filesystemobject")
Response.Write("<p style=" & "margin-left:10px;" & "><img src=" & "./img/right_arrowblue.png" & " alt=" & "Expand/Collapse" & " id=" & "arrow_" & adoRec("Week") & " /><strong>[" & adoRec("Date") & "]</strong> " & ""&aroRec("First") & adoRec("Last") & ", " & adoRec("Affiliation") & "</p>")
The very last line of code causes this error
ADODB.Recordset error '800a0cc1'
Item cannot be found in the collection corresponding to the requested name or ordinal.
FilePath, line 244
Line 244 is the very last line of code that should write Some information about each seminar on the webpage.
I'm pretty sure at this point I am pointing to an incorrect file path because I have an extra space somewhere in all the different string.
My question now is Would the ones in the very beginning, meaning the ones used in
"<p style=" & "margin-left:10px;" & "><img src=" & "./img/right_arrowblue.png"
be causing the trouble.
I'm also unfamiliar with using the "Expand/collapse" so if someone could tell me a little more about that. I am trying to fix someone elses code so I am a little behind the 8 ball.
One small step to a solution:
Your SQL
"SELECT * FROM Seminars WHERE [SeminarID] = 5 ORDER BY DESC"
is definitely wrong: ORDER BY needs (at least) a column name: ORDER BY [SeminarID] DESC.
If that does not solve all your problems, we'll have to think about a step by step approach.
If you get errors, tell us about them (number, description, line). That's what I meant, when I ask you to publish them. If you can't better info than "There was an error when processing the URL" from IIS, then you have to write some command line script to get the database related code absolutely right.
Start with experiments.vbs:
Dim sCS : sCS = !your connection string!
Dim oCN : Set oCN = CreateObject("ADODB.Connection")
oCN.Open sCS
WScript.Echo "CN open:", oCN.State
Dim sSQL : sSQL = !your SQL statement!
Dim oRS : Set oRS = oCN.Execute(sSQL)
WScript.Echo "RS EOF:", CStr(oRS.EOF)
WScript.Echo "Frs Col:", oRS.Fields(0).Name, oRS.Fields(0).Type
Dim i : i = 0
Do Until oRS.EOF
WScript.Echo i, oRS.Fields(0).Value
i = i + 1
oRS.MoveNext
Loop
oCN.Close
and run it in a command window (DOS box): cscript experiments.vbs. This should get you either some lines like:
CN open: 1
RS EOF: False
Frs Col: Id 3
0 ...
1 ...
2 ...
or a focused/publishable error message like:
... .vbs(2465, 14) Microsoft OLE DB Provider for SQL Server: Falsche Syntax in der Nä
he des 'DESC'-Schlüsselworts.
(bad syntax near DESC), which got when I tried the statement
"SELECT * FROM Alpha ORDER BY DESC"
RS.MoveNext
Put the above code on the line before the Loop keyword to avoid an infinite loop.
Are you missing the loop keyword at the end of your loop block?
Check the syntax here: http://msdn.microsoft.com/en-us/library/eked04a7.aspx