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.
Related
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
unfortunately I am forced to use ASP for this particular task. I need my form to post its data to a CSV and then send an email notifying the client. Now the first bit I already have working (posting the data to a CSV file) but its the email notification that is getting me, as I have no idea how or what to incorporate into my current code in order for this to happen.
Here is a link to the form in question:
http://dev.brandspank.co.za/form/index.html
And below is my ASP code:
<% option explicit
dim objFSO, objTXT, lines, newRecord, filePath, fieldNames, x, fullText, nLine %>
<h1>Form inputs posted:</h1>
<%
for each x in request.form
response.write x & ": " & Replace(request.form(x), ",","-") & "<br />" & vbNewLine
next
'set filepath for plain text db. This neds to be the absolute path of file
filePath = "\form\myCSVdb.csv"
set objFSO = server.createobject("Scripting.FileSystemObject")
if (objFSO.fileExists(filePath))=true then
set objTXT = objFSO.openTextFile(filePath, 1) 'opens a text file for
' reading, true means it will create the file if not already there
fullText = trim(objTXT.readall)
lines = split(fullText, vbNewLine) 'lines is now an array, each item is
' one line of the db file.this could now be used to list the entire db
' table, notice next 3 commented out lines
' for each x in lines
' response.write lines(x)
' next
objTXT.close
set objTXT = nothing
if trim(lines(0)) = "" then fullText = ""
else
fullText = ""
end if %>
<h1>added to the db:</h1>
<%
if fullText <> "" then 'there are already field names in the db,
' so put the new line in the same order
set objTXT = objFSO.openTextFile(filePath, 8, True) 'opens the text file for
' appending
response.write "(fields in the database: " & lines(0) & ")<br />" & vbNewLine
'split the first line, which had field names into an array -fieldNames-
fieldNames = split(lines(0), ",")
response.write "field values entered:<br />" & vbNewLine
for each x in fieldNames
if x <> "" then
nLine = nLine & Replace(request.form(x), ",","-") & ","
'adds each form input to a string
response.write x & ": " & Replace(request.form(x), ",","-") & "<br />" & vbNewLine
end if
next
nLine = left(nLine, len(nLine)-1)
'removes trailing comma
objTXT.writeLine nLine
else 'there isn't anything in the textfile yet, so put in the field names first
set objTXT = objFSO.openTextFile(filePath, 2, True) 'opens the text file for
' writing
response.write "field names enterd:<br />" & vbNewLine
for each x in request.form
if Replace(lcase(x), ","," ") <> "submit" then 'or you will have a "submit" field in your db
'of course, if your submit button is named something else, that should
'be the name xcluded here
nLine = nLine & x & ","
'adds each form input name to a string which will become th first line of
'the db, the line which shows field names
response.write x & "<br />" & vbNewLine
end if
next
nLine = left(nLine, len(nLine)-1)
'remove trailing comma
objTXT.write nLine
objTXT.write vbNewLine
nLine = ""
response.write "field values entered:<br />" & vbNewLine
for each x in request.form
if lcase(x) <> "submit" then
nLine = nLine & Replace(request.form(x), ",","-") & ","
'adds each form input to a string
response.write Replace(request.form(x), ",","-") & "<br />" & vbNewLine
end if
next
nLine = left(nLine, len(nLine)-1)
'remove trailing comma
objTXT.write nLine
objTXT.write vbNewLine
end if
objTXT.close
%>
<% response.redirect "thankyou.html" %>
Any help would be very much appreciated!
I put pretty much everything you need here:
www.oceanmedia.net/files/2014-06-form-process.zip
Included:
form_process. asp
i_fn_email_cdo.asp
i_check_security.asp
i_odbc.asp
i_fn_clean.asp
i_fn_dirty.asp
Oh and the text file part:
<%
Dim fso, f
Set fso = CreateObject("Scripting.FileSystemObject")
'Open the file for reading
Set f = fso.CreateTextFile(s_path & "/" & s_file_being_created, True)
f.Write(m)
f.Close
Set f = Nothing
Set fso = Nothing
%>
Sorry, I don't yet have comment privileges, so this will be a comment disguised as an answer: the specifics will depend upon how your web server is configured in terms of email, but assuming it is somewhat current, you will probably be using CDOSYS to do so, and here is a link to a very basic intro: http://www.w3schools.com/asp/asp_send_email.asp
You've navigated the FileSystemObject, so you'll probably find this fairly straightforward once you get the details right on your mail server.
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
I am trying to add an image from an Excel sheet to an Outlook email.
I tried using a link to an image stored in a network location and on the Internet. However, not all users will have access to these locations.
Is it possible to store the image in another worksheet and then copy it into the email body?
I know the below won't work because you can't export shapes but can I do something like this?
ActiveUser = Environ$("UserName")
TempFilePath = "C:\Users\" & ActiveUser & "\Desktop\"
Sheets("Images").Shapes("PanelComparison").Export TempFilePath & "\PanelComparison.png"
panelimage = "<img src = ""TempFilePath\PanelComparison.png"" width=1000 height=720 border=0>"
The CreateEmail Sub calls the SaveToImage Sub. The SaveToImage sub grabs a range, creates a chart on a new page and then saves the picture(objChart) to a specified directory.
The LMpic string variable calls the image just saved and inputs it into the HTML body.
Public Sub CreateEmail()
Dim OutApp As Object
Dim OutMail As Object
Dim cell As Range
Dim FN, LN, EmBody, EmBody1, EmBody2, EmBody3 As String
Dim wb As Workbook
Dim ws As Worksheet
Application.ScreenUpdating = False
Set OutApp = CreateObject("Outlook.Application")
Set wb = ActiveWorkbook
Set ws = Worksheets("Sheet1")
Call SaveToImage
ws.Activate
LMpic = wb.Path & "\ClarityEmailPic.jpg'"
On Error GoTo cleanup
For Each cell In Columns("D").Cells.SpecialCells(xlCellTypeConstants)
If cell.Value Like "?*#?*.?*" Then
FN = Cells(cell.Row, "B").Value
LN = Cells(cell.Row, "A").Value
EmBody = Range("Email_Body").Value
EmBody1 = Range("Email_Body1").Value
EmBody2 = Range("Email_Body2").Value
'EmBody3 = Range("Email_Body3").Value
Set OutMail = OutApp.CreateItem(0)
On Error Resume Next
With OutMail
.To = cell.Value
.Subject = "Volt Clarity Reminder "
.Importance = olImportanceHigh
.HTMLBody = "<html><br><br><br>" & _
"<table border width=300 align=center>" & _
"<tr bgcolor=#FFFFFF>" & _
"<td align=right>" & _
"<img src='" & objRange & "'>" & _
"</td>" & _
"</tr>" & _
"<tr border=0.5 height=7 bgcolor=#102561><td colspan=2></td></tr>" & _
"<tr>" & _
"<td colspan=2 bgcolor=#E6E6E6>" & _
"<body style=font-family:Arial style=backgroung-color:#FFFFFF align=center>" & _
"<p> Dear " & FN & " " & LN & "," & "</p>" & _
"<p>" & EmBody & "</p>" & _
"<p>" & EmBody2 & "<i><font color=red>" & EmBody1 & "</i></font>" & "</p>" & _
"</body></td></tr></table></html>"
.Display 'Or use Display
End With
On Error GoTo 0
Set OutMail = Nothing
End If
Next cell
cleanup:
Set OutApp = Nothing
Application.ScreenUpdating = True
End Sub
Public Sub SaveToImage()
'
' SaveToImage Macro
'
Dim DataObj As Shape
Dim objChart As Chart
Dim folderpath As String
Dim picname As String
Dim ws As Worksheet
Application.ScreenUpdating = False
Set ws = Worksheets("Sheet2")
folderpath = Application.ActiveWorkbook.Path & Application.PathSeparator 'locating & assigning current folder path
picname = "ClarityEmailPic.jpg" 'image file name
Application.ScreenUpdating = False
Call ws.Range("Picture").CopyPicture(xlScreen, xlPicture) 'copying the range as an image
Worksheets.Add(after:=Worksheets(1)).Name = "Sheet4" 'creating a new sheet to insert the chart
ActiveSheet.Shapes.AddChart.Select
Set objChart = ActiveChart
ActiveSheet.Shapes.Item(1).Width = ws.Range("Picture").Width 'making chart size match image range size
ActiveSheet.Shapes.Item(1).Height = ws.Range("Picture").Height
objChart.Paste 'pasting the range to the chart
objChart.Export (folderpath & picname) 'creating an image file with the activechart
Application.DisplayAlerts = False
ActiveWindow.SelectedSheets.Delete 'deleting sheet4
Application.DisplayAlerts = True
End Sub
In general email images are stored on a web server, with the SRC pointing to that server (http://...). They're not embedded in the email itself.
I have a situation where i need to place a header line of information into a CSV file.
After which, i will need to append 3 queries, of varying column numbers, to this file.
Currently have this logic, but the TransferText line overwrites what i had placed in the file prior to it:
Dim fldr As String
Dim dlg As Office.FileDialog
Set dlg = Application.FileDialog(msoFileDialogFolderPicker)
With dlg
.AllowMultiSelect = False
.Title = "Select a Folder:"
.Filters.Clear
'.Filters.Add "CSV Files", "*.csv"
If .show = True Then
fldr = .SelectedItems(1)
End If
End With
GC dlg
'TODO: Remove after Debugging is complete
RaiseAlert "Folder chosen: " & fldr
'-----------------------------------------
Dim file As String
file = fldr & "\Export_DelaGet_" & Format(Now(), "yyyy_mm_dd") & ".csv"
'TODO: Remove after Debugging is complete
RaiseAlert "File: " & file
'-----------------------------------------
'TODO: OpenFile and output the header line
Open file For Output As #1
Print #1, """SYS"",""Some Data""" & vbCrLf
Close 1
'Output Query/View Results to file
DoCmd.TransferText acExportDelim, "MstPrc_Spec", "vwMasterPrices_Output", file, False
Would it be better for me to just Iterate through the query via RecordSet or am i missing something in TransferText?
Unless someone else can provide me a better way of performing this, here is what i have so far.
Dim fldr As String
Dim dlg As Office.FileDialog
Set dlg = Application.FileDialog(msoFileDialogFolderPicker)
With dlg
.AllowMultiSelect = False
.Title = "Select a Folder:"
.Filters.Clear
'.Filters.Add "CSV Files", "*.csv"
If .show = True Then
fldr = .SelectedItems(1)
End If
End With
GC dlg
'TODO: Remove after Debugging is complete
' RaiseAlert "Folder chosen: " & fldr
'-----------------------------------------
Dim file As String
file = fldr & "\Export_" & Format(Now(), "yyyy_mm_dd") & ".csv"
'TODO: Remove after Debugging is complete
' RaiseAlert "File: " & file
'-----------------------------------------
'TODO: OpenFile and output the header line
Open file For Output As #1
Print #1, """SYS"",""Some Data""" & vbCrLf
Close 1
Open file For Append As #2
Dim rst As DAO.Recordset, str As String
'Append MasterPrices
Set rst = CurrentDb.OpenRecordset("vwMasterPrices_Output")
If rst.RecordCount > 0 Then
Do While Not rst.EOF
str = """" & rst(0) & """,""" & rst(1) & """,""" & rst(2) & """,""" & rst(3) & """,""" & rst(4) & """," & Format(rst(5), "##0.00")
Print #2, str
'Move Next
rst.MoveNext
Loop
End If
'Append GroupPrice
Set rst = CurrentDb.OpenRecordset("vwGroupPrice_Output")
If rst.RecordCount > 0 Then
Do While Not rst.EOF
str = """" & rst(0) & """,""" & rst(1) & """,""" & rst(2) & """," & Format(rst(3), "##0.00")
Print #2, str
'Move Next
rst.MoveNext
Loop
End If
'Append GroupLocations
Set rst = CurrentDb.OpenRecordset("vwGroupLocations_Output")
If rst.RecordCount > 0 Then
Do While Not rst.EOF
str = """" & rst(0) & """,""" & rst(1) & """," & rst(2)
Print #2, str
'Move Next
rst.MoveNext
Loop
End If
GC rst
Close 2
Unfortunately the TransferText method performs a File-Output and not a File-Append operation. So anything in the file prior to the TransferText is cleared and replaced with the output of the method.
Yes i had to have text qualifiers around Strings for the CSV.