I've got a table that has an embedded OLE field that contains RichText formatted data. I need to transfer this data to MySQL database and convert it to HTML. I use Access. Is there a way to do it quickly in VBA?
I searched the web, most people use RichText control (richtx32.ocx) to get plain text, but I need it to remain formatted and I also don't have this control.
Here is how I solved my problem:
Option Explicit
Public wrd As Word.Application
Public doc As Word.Document
Function RTF2HTMLviaWord(rtf As String) As String
'Open Tools --> References --> and check Microsoft Scripting Runtime
Dim fso As New FileSystemObject
Dim text As TextStream
Dim temp As String
temp = Environ("TEMP")
If Len(rtf) > 1 Then
Set text = fso.CreateTextFile(temp & "\RTF2HTML.rtf", True)
text.Write rtf
text.Close
If wrd Is Nothing Then
Set wrd = New Word.Application
End If
Set doc = wrd.Documents.Open(temp & "\RTF2HTML.rtf", False)
doc.SaveAs temp & "\RTF2HTML.htm", wdFormatHTML
doc.Close
fso.DeleteFile temp & "\RTF2HTML.rtf"
Set text = fso.OpenTextFile(temp & "\RTF2HTML.htm", ForReading, False)
RTF2HTMLviaWord = text.ReadAll
text.Close
fso.DeleteFile temp & "\RTF2HTML.htm"
Else
RTF2HTMLviaWord = ""
End If
End Function
The only downside is that Word produces too many garbage HTML tags. I wish it could save minimal HTML tags without formatting.
Related
I have a Access DB containing several different tables, each with a different structure (number & names of fields, number of rows, title).
What I would like to do is to export all these tables into txt files, with a given separator ("|"), point as decimal separator, quotes for strings.
I have browsed the internet and what I got was:
use DoCmd.TransferText acExportDelim command
save a customized export specification and apply it
I get an error messagge ("object does not exist") and I think it is related to the fact that the export specification is "sheet-specific", i.e. does not apply to tables with different fields and fieldnames.
Can you help me?
thanks!!
EDIT.
I post also the original code I run. As I said before, I am new to VBA, so I just looked for a code on the web, adapted it to my needs, and run.
Public Sub ExportDatabaseObjects()
On Error GoTo Err_ExportDatabaseObjects
Dim db As Database
Dim db As DAO.Database
Dim td As TableDef
Dim sExportLocation As String
Dim a As Long
Set db = CurrentDb()
sExportLocation = "C:\" 'Do not forget the closing back slash! ie: C:\Temp\
For a = 0 To db.TableDefs.Count - 1
If Not (db.TableDefs(a).Name Like "MSys*") Then
DoCmd.TransferText acExportDelim, "Export_specs", db.TableDefs(a).Name, sExportLocation & db.TableDefs(a).Name & ".txt", True
End If
Next a
Set db = Nothing
MsgBox "All database objects have been exported as a text file to " & sExportLocation, vbInformation
Exit_ExportDatabaseObjects:
Exit Sub
Err_ExportDatabaseObjects:
MsgBox Err.Number & " - " & Err.Description
Resume Exit_ExportDatabaseObjects
End Sub
Before running the code, I manually exported the first table saving the Export_specs to a file.
Consider a db with two tables, A and B.
When I run the code A is properly exported, then I get the following errore message "3011 - The Microsoft Access database engine could not find the object 'B#txt'. Make sure the object exists and that you spell its name and the path name correctly. If 'B#txt' is not a local object, check your network connection or contact the server administration".
So, it's kind of complex. I've created a routine that imports files using ImportExport Specs, you should be able to easily adapt to your purpose. The basic operation is to create a spec that does exactly what you want to one file. Then, export this spec using this code:
Public Function SaveSpecAsXMltoTempDirectory(sSpecName As String)
Dim oFSO As FileSystemObject
Dim oTS As TextStream
Set oFSO = New FileSystemObject
Set oTS = oFSO.CreateTextFile("C:\Temp\" & sSpecName & ".xml", True)
oTS.Write CurrentProject.ImportExportSpecifications(sSpecName).XML
oTS.Close
Set oTS = Nothing
Set oFSO = Nothing
End Function
Then open this file in Notepad and replace the file name with some placeholder (I used "FILE_PATH_AND_NAME" in this sample). Then, import back into database using this code:
Public Function SaveSpecFromXMLinTempDirectory(sSpecName As String)
Dim oFSO As FileSystemObject
Dim oTS As TextStream
Dim sSpecXML As String
Dim oSpec As ImportExportSpecification
Set oFSO = New FileSystemObject
Set oTS = oFSO.OpenTextFile("C:\Temp\" & sSpecName & ".xml", ForReading)
sSpecXML = oTS.ReadAll
For Each oSpec In CurrentProject.ImportExportSpecifications
If oSpec.Name = sSpecName Then oSpec.Delete
Next oSpec
Set oSpec = CurrentProject.ImportExportSpecifications.Add(sSpecName, sSpecXML)
Set oSpec = Nothing
oTS.Close
Set oTS = Nothing
Set oFSO = Nothing
End Function
Now you can cycle thru the files and replace the placeholder in the spec with the filename then execute it using this code:
Public Function ImportFileUsingSpecification(sSpecName As String, sFile As String) As Boolean
Dim oSpec As ImportExportSpecification
Dim sSpecXML As String
Dim bReturn As Boolean
'initialize return variable as bad until function completes
bReturn = False
'export data using saved Spec
' first make sure no temp spec left by accident
For Each oSpec In CurrentProject.ImportExportSpecifications
If oSpec.Name = "Temp" Then oSpec.Delete
Next oSpec
sSpecXML = CurrentProject.ImportExportSpecifications(sSpecName).XML
If Not Len(sSpecXML) = 0 Then
sSpecXML = Replace(sSpecXML, "FILE_PATH_AND_NAME", sFile)
'now create temp spec to use, get template text and replace file path and name
Set oSpec = CurrentProject.ImportExportSpecifications.Add("Temp", sSpecXML)
oSpec.Execute
bReturn = True
Else
MsgBox "Could not locate correct specification to import that file!", vbCritical, "NOTIFY ADMIN"
GoTo ExitImport
End If
ExitImport:
On Error Resume Next
ImportFileUsingSpecification = bReturn
Set oSpec = Nothing
Exit Function
End Function
Obviously you'll need to find the table name in the spec XML and use a placeholder on it as well. Let me know if you can't get it to work and i'll update for export.
I am copying formatted text from a Word document into a rich text field in Access.
Later I want to use VBA to create a new Word document and write the text as formatted to it.
The problem is, Access saves rich text with HTML formatting. And when you try to write that to a doc or docx, you see the text and its HTML tags.
How do I write the text to a Word document so that it retains the intended formatting and doesn't show HTML codes?
The only way I have found that works (without modifying the input string) is to write the HTML to a temporary file, then use .InsertFile to load that file into the word document. Here's a sub that takes the input argument and puts it into a new Word document:
Sub WriteToWord(myHtmlFormattedText as String)
Dim objWord As Word.Application
Dim doc As Word.Document
Dim fso As Object ' FileSystemObject
Dim f As Object ' TextStream
Dim tempHtmlFile As String
' Write your HTML content to a temp file:
Set fso = CreateObject("Scripting.FileSystemObject")
tempHtmlFile = fso.GetSpecialFolder(2) & "\" & fso.GetTempName & ".htm"
Set f = fso.CreateTextFile(tempHtmlFile, True)
f.Write myHtmlFormattedText
f.Close
Set f = Nothing
Set fso = Nothing
' Set up word object
Set objWord = CreateObject("Word.Application")
With objWord
.Visible = True
Set doc = .Documents.Add
End With
'Add HTML file contents:
objWord.Selection.InsertFile tempHtmlFile
' Show the doc
doc.Activate
End Sub
Not sure this will help, but there are a few different pasting features in Microsoft Word (in thee upper left corner of the 'Home' tab) that many people overlook
This allows you to paste with/without formatting. Not sure if it will solve your specific issue, but hopefully!
In my code I open a word document from MS Access and read out a certain section of the document. If I was doing this and would only have to store the plain text, this would be easy enough... but I need to keep all the formatting.
From what I've read on the web, Access 2007 and up can easily store Rich Text Formatt (RTF). I adjusted my Access Table to have the specified field defined as "Memo" and "Rich Text". So the field itself is set up and working properly.
Copying and pasting some data manually gets stored as it should.
My question to which I can't seem to find an answer: How do you do it using Code???
Here is the relevant code snippet for what I have so far:
Set doc = New Word.Application
doc.Visible = True
Set dcmt = doc.Documents.Open(sPathTemplate)
Set sectn = dcmt.Sections(2)
Dim x As String
sAnalystText = sectn.Range.Tables(1).cell(1, 1).Range.FormattedText
rsComments.AddNew
rsComments![ISIN] = "Fake_ISIN"
rsComments![Fund_Selection] = 1
rsComments![Long Comment Exec] = sAnalystText
rsComments.Update
I have tried using both .Text and .FormattedText but neither works.
Any help much appreciated!
Dim rs As New ADODB.Recordset
Dim A() As Byte
Dim myrtf As Variant
Dim doact As Document
Set doact = ActiveDocument
myrtf = Null
ActiveDocument.Range(0, 100).Copy
Dim dc As New Document
dc.Activate
dc.Range(0, 0).PasteAndFormat wdFormatOriginalFormatting
dc.SaveAs2 FileName:="C:\x.rtf", FileFormat:=wdFormatRTF
dc.Close
doact.Activate
Open "C:\x.rtf" For Binary As #1
ReDim A(LOF(1))
While Not (EOF(1))
Get #1, , A(i)
i = i + 1
Wend
Close #1
myrtf = A
conn.Open "Driver={Microsoft Access Driver (*.mdb, *.accdb)};Dbq=C:\test.accdb"
strsql = "Insert into table ( rftfield) values ('" & myrtf & "')"
conn.Execute strsql
conn.Close
I'm writing a query to extract text that was entered through a vendor-created word processor to an Oracle database and I need to export it to Word or Excel. The text is entered into a memo field and the text is intertwined with codes that the word processor uses for different functions (bold, indent, hard return, font size, etc.).
I've used the replace function to parse out a lot of the more common codes, but there are so many variations, it's nearly impossible to catch them all. Is there a way to do this? Unfortunately, I'm limited to using Microsoft Access 2010 to try and accomplish this.
The common thread I've found is that all the codes start with a back-slash and I'd like to be able to delete all strings that start with a back-slash up to the next space so all the codes are stripped out of the final text.
Here's a brief example of the text I'm working with:
{\rtf1\ansi\ansicpg1252\deff0\deflang1033{\fonttbl{\f0\fnil\fcharset0 Times New Roman;
\viewkind4\uc1\pard\f0\fs36 An abbreviated survey was conducted
on 02/02/15 to investigate complaint #OK000227. \par
No deficiencies were cited.\par
\fs20\par
}}
If your machine has Microsoft Word installed then you already have an RTF parser available so you don't have to "roll your own". You can just get Word to open the RTF document and save it as plain text like this:
Option Compare Database
Option Explicit
Public Function RtfToPlainText(rtfText As Variant) As Variant
Dim rtn As Variant
Dim tempFolder As String, rtfPath As String, txtPath As String
Dim fso As Object ' FileSystemObject
Dim f As Object ' TextStream
Dim wordApp As Object ' Word.Application
Dim wordDoc As Object ' Word.Document
Dim tempFileName As String
tempFileName = "~RtfToPlainText"
If IsNull(rtfText) Then
rtn = Null
Else
' save RTF text as file
Set fso = CreateObject("Scripting.FileSystemObject")
tempFolder = fso.GetSpecialFolder(2) ' Temporaryfolder
rtfPath = tempFolder & "\" & tempFileName & ".rtf"
Set f = fso.CreateTextFile(rtfPath)
f.Write rtfText
f.Close
Set f = Nothing
' open in Word and save as plain text
Set wordApp = CreateObject("Word.Application")
Set wordDoc = wordApp.Documents.Open(rtfPath)
txtPath = tempFolder & "\" & tempFileName & ".txt"
wordDoc.SaveAs2 txtPath, 2 ' wdFormatText
wordDoc.Close False
Set wordDoc = Nothing
wordApp.Quit False
Set wordApp = Nothing
fso.DeleteFile rtfPath
' retrieve plain text
Set f = fso.OpenTextFile(txtPath)
rtn = f.ReadAll
f.Close
Set f = Nothing
fso.DeleteFile txtPath
Set fso = Nothing
End If
RtfToPlainText = rtn
End Function
Then, if you had a table with two Memo fields - [rtfText] and [plainText] - you could extract the plain text into the second Memo field using the following query in Access:
UPDATE rtfTestTable SET plainText = RtfToPlainText([rtfText]);
The text you are working with is RTF. Here is a tutorial about the file format.
This link (on another site, registration required) may give you copy & paste code you can use to convert rtf fields to txt.
You may be able to copy the value of the field from the database and paste it into notepad and then save the notepad file as "test.rtf"...you could then double click the file icon and the document may open.
RTF is an old MS file format that allows formatting of text. See this wikipedia page.
Background Information:
I am not very savvy with VBA, or Access for that matter, but I have a VBA script that creates a file (a KML to be specific, but this won't matter much for my question) on the users computer and writes to it using variables that link to records in the database. As such:
Dim MyDB As Database
Dim MyRS As Recordset
Dim QryOrTblDef As String
Dim TestFile As Integer
QryOrTblDef = "Table1"
Set MyDB = CurrentDb
Set MyRS = MyDB.OpenRecordset(QryOrTblDef)
TestFile = FreeFile
Open "C:\Testing.txt"
Print #TestFile, "Generic Stuff"
Print #TestFile, MyRS.Fields(0)
etc.
My Situation:
I have a very large string(a text document with a large list of polygon vertex coordinates) that I want to add to a variable to be printed to another file (a KML file, noted in the above example). I was hoping to add this text file containing coordinates as an attachment datatype to the Access database and copy its contents into a variable to be used in the above script.
My Question:
Is there a way I can access and copy the data from an attached text file (attached as an attachment data type within a field of an MS Access database) into a variable so that I can use it in a VBA script?
What I have found:
I am having trouble finidng information on this topic I think mainly because I do not have the knowledge of what keywords to be searching for, but I was able to find someones code on a forum, "ozgrid", that seems to be close to what I want to do. Though it is just pulling from a text file on disk rather than one attached to the database.
Code from above mentioned forum that creates a function to access data in a text file:
Sub Test()
Dim strText As String
strText = GetFileContent("C:\temp\x.txt")
MsgBox strText
End Sub
Function GetFileContent(Name As String) As String
Dim intUnit As Integer
On Error Goto ErrGetFileContent
intUnit = FreeFile
Open Name For Input As intUnit
GetFileContent = Input(LOF(intUnit), intUnit)
ErrGetFileContent:
Close intUnit
Exit Function
End Function
Any help here is appreciated. Thanks.
I am a little puzzled as to why a memo data type does not suit if you are storing pure text, or even a table for organized text. That being said, one way is to output to disk and read into a string.
''Ref: Windows Script Host Object Model
Dim fs As New FileSystemObject
Dim ts As TextStream
Dim rs As DAO.Recordset, rsA As DAO.Recordset
Dim sFilePath As String
Dim sFileText As String
sFilePath = "z:\docs\"
Set rs = CurrentDb.OpenRecordset("maintable")
Set rsA = rs.Fields("aAttachment").Value
''File exists
If Not fs.FileExists(sFilePath & rsA.Fields("FileName").Value) Then
''It will save with the existing FileName, but you can assign a new name
rsA.Fields("FileData").SaveToFile sFilePath
End If
Set ts = fs.OpenTextFile(sFilePath _
& rsA.Fields("FileName").Value, ForReading)
sFileText = ts.ReadAll
See also: http://msdn.microsoft.com/en-us/library/office/ff835669.aspx