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
Related
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.
I'm developing a VB Script for WinCC RunTime on a SIMATIC PC station to export the historical data of my project once a month. I'm setting up an ADO connection and querying the results into a recordset that I'm printing to a csv. I'm having several problems:
The recordset returns a ValueID, I want to be able to find the tagname that corresponds to it and write it to the csv.
I am limited to 20 tags per query, but I want to export 30 tags.
Running a for loop of the query for each tag produces nothing.
My code currently looks like this:
Dim fso
Dim f
Dim ts
Dim path
Dim TimeStamp
Dim Pro
Dim DSN
Dim DS
Dim ConnString
Dim MachineNameRT
Dim DSNRT
Dim Conn
Dim RecSet
Dim Command
Dim CommandText
TimeStamp = localDateFormat(Now)
path = "C:\Logs\Test1_" & TimeStamp & ".csv"
Set fso = CreateObject("Scripting.FileSystemObject")
If Not fso.FileExists(path) Then
fso.CreateTextFile(path)
Else
MsgBox "File already exist:" & vbCrLf & path
Exit Sub
End If
Set f = fso.GetFile(path)
Set ts = f.OpenAsTextStream(2,-2)
Set MachineNameRT = HMIRuntime.Tags("#LocalMachineName")
Set DSNRT = HMIRuntime.Tags("#DatasourceNameRT")
Pro="Provider=WinCCOLEDBProvider.1;"
DSN="Catalog=" & DSNRT.Read & ";"
DS= "Data Source=" & MachineNameRT.Read & "\WinCC"
ConnString = Pro + DSN + DS
Set Conn = CreateObject("ADODB.Connection")
Conn.ConnectionString = ConnString
Conn.CursorLocation = 3
Conn.open
Set Command = CreateObject("ADODB.Command")
Command.CommandType = 1
Set Command.ActiveConnection = Conn
ts.WriteLine ("Tag-Name;ValueID;Date/Time;Process-Value")
CommandText="Tag:R,'Data_Log\TempTran','0000-01-00 00:00:00.000','0000-00-00 00:00:00.000'"
Command.CommandText=CommandText
Set RecSet = Command.Execute
RecSet.MoveFirst
Do While Not RecSet.EOF
ts.WriteLine ("TempTran;" & RecSet.Fields("ValueID").Value & ";" & RecSet.Fields("TimeStamp").Value & ";" & RecSet.Fields("RealValue").Value)
RecSet.MoveNext
Loop
ts.Close
RecSet.Close
Set RecSet=Nothing
Set Command = Nothing
Conn.Close
Set Conn = Nothing
Set fso = Nothing
Set f = Nothing
Set ts = Nothing
What I need as an end result is a CSV file that displays like this
Tag-Name;ValueID;Date/Time;Process-Value;
TempTran;1;dd/mm/yyyy hh:mm:ss;xxx.xxx;
TempTran;1;dd/mm/yyyy hh:mm:ss;xxx.xxx;
PresTran;2;dd/mm/yyyy hh:mm:ss;xxx.xxx;
.
.
.
.
LimitSwt;30;dd/mm/yyyy hh:mm:ss;xxx.xxx;
LimitSwt;30;dd/mm/yyyy hh:mm:ss;xxx.xxx;
LimitSwt;30;dd/mm/yyyy hh:mm:ss;xxx.xxx;
Q1:
The ValueID and tagname is in the Table "Archive" if the database is linked to connectivity pack.
SELECT [ValueID]
,[ValueName]
FROM [CC_ExternalBrowsing].[dbo].[Archive]
Otherwise you can find the valueId in the CS database
Runtime is in this case "CC_GruppLar_15_05_06_10_35_08R", its the last 'R' that indicate "runtime", remove this and you are in the construction database(CS):
Varname = the given name
procvarname= the tag that is archived.
TLGTAGID = The ValueID
SELECT [VARNAME]
,[PROCVARNAME]
,[TLGTAGID]
FROM [CC_GruppLar_15_05_06_10_35_08].[dbo].[PDE#TAGs]
Q3:
perhaps this note about months in the fine help can help? or try to verify using that there is data present for this tag. I think its a good idea to test the SQL statements using the given tool "Microsoft SQL Manager Studio", that's faster then using excel...
Note
Enter a relative period you want to query in a linked archive database using the following format:
0000-00-DD hh:mm:ss.msc
If you indicate the time frame in months, the content can be faulty, because a month can have 28 to 31 days.
Example for reference:
Exporting Archive Data with the Aid of the SIMATIC WinCC/Connectivity Pack (OLE DB Provider)
https://support.industry.siemens.com/cs/se/en/view/38132261
I am trying to read JPG images from MS-Access database using the following code in classic ASP:
Response.Expires = 0
Response.Buffer = TRUE
Response.Clear
Response.ContentType = "image/jpg"
Set cn = Server.CreateObject("ADODB.Connection")
cn.Open "Provider=Microsoft.Jet.OLEDB.4.0; Data Source=" & Server.MapPath("/database/database.mdb")
sqlString = "Select * from tblBusinessImages where fldID = " & request.querystring("id")
Set rs = cn.Execute(sqlString)
Response.BinaryWrite rs("fldImageData")
Response.End
But I keep getting an error telling that the browser can't read or display the image.
The database field 'tblBusinessImages' is an OLE field, and the image is saved into it by copy-paste, only for testing purpose at this time (could this be a wrong way?)
Now I know that MS-Access saves extra data in the BLOB object (as MSDN says here:
If any extraneous information is contained in the BLOB data, this will
be passed by this script, and the image will not display properly.
This becomes important when you realize that most methods of placing
images into BLOB fields place extra information in the form of headers
with the image. Examples of this are Microsoft Access and Microsoft
Visual FoxPro. Both of these applications save OLE headers in the BLOB
field along with the actual binary data.
)
My question is how do I read the RAW image data from a BLOB without the extra data/headers that MS-Access saves?
Thanks.
After a day of work I realized what the problem was: The problem was in the way the picture was saved to the database (manually).
In order to save images to database, the following code should be used:
Dim fileName
Dim conn
Dim rsTemp
Dim fldID
Dim sSQL
Dim mystream
Set mystream = Server.CreateObject("ADODB.Stream")
mystream.Type = 1
mystream.Open
mystream.LoadFromFile "D:\Desktop\My Downloads\compose1.jpg"
Set conn = Server.CreateObject("ADODB.Connection")
Set rsTemp = Server.CreateObject("ADODB.Recordset")
conn.Open "DRIVER=Microsoft Access Driver (*.mdb);DBQ=" & Server.MapPath("/database/database.mdb")
sSQL = "Select fldImageData from tblBusinessImages where fldID = 1;"
rsTemp.Open sSQL, conn, 3, 3
rsTemp.Fields("fldImageData").AppendChunk mystream.Read
rsTemp.Update
rsTemp.Close
set mystream = nothing
And in order to read an image from MS-Access database, this code should be used:
Dim conn
Dim rsTemp
Dim sSQL
Dim fldID
fldID = Request.QueryString("id")
If Not fldID = "" And IsNumeric(fldID) Then
Set conn = Server.CreateObject("ADODB.Connection")
Set rsTemp = Server.CreateObject("ADODB.Recordset")
conn.Open "DRIVER=Microsoft Access Driver (*.mdb);DBQ=" & Server.MapPath("/database/database.mdb")
sSQL = "Select * from tblBusinessImages where fldID = " & request.querystring("id")
rsTemp.Open sSQL, conn, 3, 3
If Not rsTemp.EOF Then
Response.ContentType = "image/jpeg"
Response.BinaryWrite rsTemp("fldImageData")
Else
Response.Write("File could not be found")
End If
rsTemp.Close
conn.Close
Set rsTemp = Nothing
Set conn = Nothing
Else
Response.Write("File could not be found")
End If
This way the image data will be saved as Long Binary Data in the OLE field in the database. When read, it will be posted to the browser as a readable image data.
So I navigated to the following MSDN Resource Page that addresses how to use ADO objects. My problem is that I cannot get it to work.
What I am trying to do is open a CSV file and read it line-by-line, then create SQL INSERT statements to insert the records into an existing Table in Access 2010. I have tried to find an easier method of doing this, but this appears to be my only option. doing this with the included tools, but so far, I haven't had any luck.
The main issue here is that I have CSV files with inconsistent headings. I want to import 5 files into the same table, but each file will be different depending on which fields contained data. Those fields with no data in them were ignored during the extract. This is why I can't use something like DoCmd.TransferText.
So, now I need to create a script that will open the text file, read the headers in the first line and create a SQL INSERT statement dependent on the configuration of that particular file.
I have a feeling that I have a good handle on how to appraoch the issue, but no matter what I try, I can't seem to get things working using ADO.
Could anyone explain how I can achieve this? My sticking point is getting the Access DB to receive information from the CSV files via ADO.
Instead of reading the CSV file line-by-line, then doing something with each line, I think you should open the file as an ADO recordset. And open a DAO recordset for your Access destination table.
You can then iterate through the fields in each row of the ADO recordset and add their values into a new row of the DAO recordset. As long as the destination table includes fields with the same names and compatible data types as the CSV fields, this can be fairly smooth.
Public Sub Addikt()
#If ProjectStatus = "DEV" Then
' needs reference for Microsoft ActiveX Data Objects
Dim cn As ADODB.Connection
Dim fld As ADODB.Field
Dim rs As ADODB.Recordset
Set cn = New ADODB.Connection
Set rs = New ADODB.Recordset
#Else ' assume PROD
Const adCmdText As Long = 1
Const adLockReadOnly As Long = 1
Const adOpenForwardOnly As Long = 0
Dim cn As Object
Dim fld As Object
Dim rs As Object
Set cn = CreateObject("ADODB.Connection")
Set rs = CreateObject("ADODB.Recordset")
#End If
Const cstrDestination As String = "tblMaster"
Const cstrFile As String = "temp.csv"
Const cstrFolder As String = "C:\share\Access"
Dim db As DAO.Database
Dim rsDao As DAO.Recordset
Dim strConnectionString As String
Dim strName As String
Dim strSelect As String
strConnectionString = "Provider=" & _
CurrentProject.Connection.Provider & _
";Data Source=" & cstrFolder & Chr(92) & _
";Extended Properties='text;HDR=YES;FMT=Delimited'"
'Debug.Print strConnectionString
cn.Open strConnectionString
strSelect = "SELECT * FROM " & cstrFile
rs.Open strSelect, cn, adOpenForwardOnly, _
adLockReadOnly, adCmdText
Set db = CurrentDb
Set rsDao = db.OpenRecordset(cstrDestination, _
dbOpenTable, dbAppendOnly + dbFailOnError)
Do While Not rs.EOF
rsDao.AddNew
For Each fld In rs.Fields
strName = fld.Name
rsDao.Fields(strName) = rs.Fields(strName).value
Next fld
rsDao.Update
rs.MoveNext
Loop
rsDao.Close
Set rsDao = Nothing
Set db = Nothing
rs.Close
Set rs = Nothing
cn.Close
Set cn = Nothing
End Sub
This is the Declarations section of the module where I saved that procedure:
Option Compare Database
Option Explicit
#Const ProjectStatus = "DEV" '"DEV" or "PROD"
Change the values for these constants to test it on your system:
Const cstrDestination As String = "tblMaster"
Const cstrFile As String = "temp.csv"
Const cstrFolder As String = "C:\share\Access"
Note the folder name does not include a trailing backslash.
You will want to adapt that procedure to pass the file name as a parameter instead of leaving it as a constant. And, if your CSV files are stored in more than one directory, you will want to pass the folder name as a parameter, too.
Hopefully showing you how to do it for one file will be enough and you can then take it from here to handle all your CSV files. Also consider adding error handling.
I think the previous answer is unnecessarily complicated. All you need to do it send an XMLHTTP request. That fetches the CSV data as a string, which can then be parsed into a table.
I've posted a VBA subroutine that does that in an answer to a similar question. Documentation of where I found the techniques is in the code comments. I've run it in Access 2019, and it works.
I'm working on a Access database which generates some mails with mail merge called from VBA code in the Access database. The problem is that if I open a new Word document and start the mail merge (VBA), Word opens the same Access database (which is already open) to get the data. Is there any way to prevent this? So that the already opened instance of the database is used?
After some testing I get a strange behavior: If I open the Access database holding the SHIFT-Key the mail merge does not open an other Access instance of the same database. If I open the Access database without holding the key, I get the described behavior.
My mail merge VBA code:
On Error GoTo ErrorHandler
Dim word As word.Application
Dim Form As word.Document
Set word = CreateObject("Word.Application")
Set Form = word.Documents.Open("tpl.doc")
With word
word.Visible = True
With .ActiveDocument.MailMerge
.MainDocumentType = wdMailingLabels
.OpenDataSource Name:= CurrentProject.FullName, ConfirmConversions:=False, _
ReadOnly:=False, LinkToSource:=False, AddToRecentFiles:=False, _
PasswordDocument:="", PasswordTemplate:="", WritePasswordDocument:="", _
WritePasswordTemplate:="", Revert:=False, Format:=wdOpenFormatAuto, _
SQLStatement:="[MY QUERY]", _
SQLStatement1:="", _
SubType:=wdMergeSubTypeWord2000, OpenExclusive:=False
.Destination = wdSendToNewDocument
.Execute
.MainDocumentType = wdNotAMergeDocument
End With
End With
Form.Close False
Set Form = Nothing
Set word = Nothing
Exit_Error:
Exit Sub
ErrorHandler:
word.Quit (False)
Set word = Nothing
' ...
End Sub
The whole thing is done with Access / Word 2003.
Update #1
It would also help if someone could tell me what the exact difference is between opening Access with or without the SHIFT-Key. And if it is possible to write some VBA code to enable the "features" so if the database is opened without the SHIFT-Key, it at least "simulates" it.
Cheers,
Gregor
When I do mailmerges, I usually export a .txt file from Access and then set the mail merge datasource to that. That way Access is only involved in exporting the query and then telling the Word document to do the work via automation, roughly as follows:
Public Function MailMergeLetters()
Dim pathMergeTemplate As String
Dim sql As String
Dim sqlWhere As String
Dim sqlOrderBy As String
'Get the word template from the Letters folder
pathMergeTemplate = "C:\MyApp\Resources\Letters\"
'This is a sort of "base" query that holds all the mailmerge fields
'Ie, it defines what fields will be merged.
sql = "SELECT * FROM MailMergeExportQry"
With Forms("MyContactsForm")
' Filter and order the records you want
'Very much to do for you
sqlWhere = GetWhereClause()
sqlOrderBy = GetOrderByClause()
End With
' Build the sql string you will use with this mail merge
sql = sql & sqlWhere & sqlOrderBy & ";"
'Create a temporary QueryDef to hold the query
Dim qd As DAO.QueryDef
Set qd = New DAO.QueryDef
qd.sql = sql
qd.Name = "mmexport"
CurrentDb.QueryDefs.Append qd
' Export the data using TransferText
DoCmd.TransferText _
acExportDelim, , _
"mmexport", _
pathMergeTemplate & "qryMailMerge.txt", _
True
' Clear up
CurrentDb.QueryDefs.Delete "mmexport"
qd.Close
Set qd = Nothing
'------------------------------------------------------------------------------
'End Code Block:
'------------------------------------------------------------------------------
'------------------------------------------------------------------------------
'Start Code Block:
'OK. Access has built the .txt file.
'Now the Mail merge doc gets opened...
'------------------------------------------------------------------------------
Dim appWord As Object
Dim docWord As Object
Set appWord = CreateObject("Word.Application")
appWord.Application.Visible = True
' Open the template in the Resources\Letters folder:
Set docWord = appWord.Documents.Add(Template:=pathMergeTemplate & "MergeLetters.dot")
'Now I can mail merge without involving currentproject of my Access app
docWord.MailMerge.OpenDataSource Name:=pathMergeTemplate & "qryMailMerge.txt", LinkToSource:=False
Set docWord = Nothing
Set appWord = Nothing
'------------------------------------------------------------------------------
'End Code Block:
'------------------------------------------------------------------------------
Finally:
Exit Function
Hell:
MsgBox Err.Description & " " & Err.Number, vbExclamation, APPHELP
On Error Resume Next
CurrentDb.QueryDefs.Delete "mmexport"
qd.Close
Set qd = Nothing
Set docWord = Nothing
Set appWord = Nothing
Resume Finally
End Function
To use this, you need to set up your Resources\Letters subfolder and put your mailmerge template word file in there. You also need your "base" query with the field definitions in your Access App (in the example, it is called MailMergeExportQry. But you can call it anything.
You also need to figure out what filtering and sorting you will do. In the example, this is represented by
sqlWhere = GetWhereClause()
sqlOrderBy = GetOrderByClause
Once you have got your head round those things, this is highly reusable.