I've a RTF file which is like a report having some text and some variable names same as the table field name. I want my program to read the RTF file character by character, then whenever it encounters a field name , it should replace it with the table field value. And whenever it encounters a space or any tag or any special character , it should write that only i.e. the format should remain the same as before only the values to be substituted in place of field names. Can you provide me the code , i need it urgently. Thanking You
-
-
You can try to use ReadLine method and to store the result in a buffer (or string),
Here you find how to use ReadLine method:
'---------------------------------------------------------------------------------------
Dim f, fs
Dim buff As String
Dim ForReading
ForReading = 1
Set fs = CreateObject("S cripting.FileSy stemObject")
Set f = fs.OpenTextFile ("c:\Documen ts and Settings\my folder\testfile .txt",ForReadin g, TristateFalse)
buff = f.Readline
f.Close
MsgBox buff ' view buffer string
'---------------------------------------------------------------------------------------
Of course this is not the complete code for your problem but it gives you a starting point.
Note:
I think it's not possible read and write the same file at once you need to use an output file
Originally posted by amitp -
It might simplify things if you place a RichTextBox control on your form (add it to your project first, under Project | Components). Once you read the file into this control, you can deal with the text, the formatting or both. And hopefully, you won't have to interpret all the tags.Originally posted by amitpComment
-
hi,
i've used the following code. but i don't know how to read the contents of the file into a string. According to you i can't read and write the same file at once, so how can i do that. how can i read the file contents into buffer and then write it to an output file to make the same format. Could you help me out. Thanking You.
Dim oWordDoc As Word.Document
Dim AppWord As New Word.Applicatio n
Dim f, fs As Object
Dim buffer As String
Dim FileName As String
FileName = "C:\KPN\Q000000 1.RTF"
Set oWordDoc = AppWord.Documen ts.Open(FileNam e)Comment
-
Here you find some code to open a .rtf , find one string then replace with another string everywhere in the file, finally save changes to an output file.
Try to adapt this code to make your own function , (it needs an empty Filename.rtf in c:\ )
'-------------------------------------------------------------------------
Private Sub CommandButton1_ Click()
Dim wrdApp As Word.Applicatio n
Dim FileName As String
Dim Sfind, Sreplace
FileName = "\Filename. rtf" ' an empty existing rtf file in c:\
Sfind = "ciao" ' string to find
Sreplace = "pippo" ' string to replace
Set wrdApp = CreateObject("W ord.Application ")
wrdApp.Visible = True
Set wrdDoc = wrdApp.Document s.Open(FileName )
' put some text with string to replace ,
wrdDoc.Content. InsertAfter "ciao Here is a ciao example test line ciao #"
'find and replace string
wrdApp.Applicat ion.Selection.F ind.ClearFormat ting
wrdApp.Applicat ion.Selection.F ind.Replacement .ClearFormattin g
With wrdApp.Selectio n.Find
.Text = Sfind
.Replacement.Te xt = Sreplace
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchKashida = False
.MatchDiacritic s = False
.MatchAlefHamza = False
.MatchControl = False
.MatchWildcards = False
.MatchSoundsLik e = False
.MatchAllWordFo rms = False
End With
wrdApp.Applicat ion.Selection.F ind.Execute Replace:=wdRepl aceAll
' Save to ouput file
With wrdDoc
.SaveAs ("\NewFilename. rtf")
.Close ' close the document
End With
wrdApp.Quit ' close the Word application
Set wrdDoc = Nothing
Set wrdApp = Nothing
End Sub
'--------------------------------------------------------------------------
Note you create a new file to store changes (NewFilename.rt f) .
I would pass to the function as parameters: FileName , Sfind and Sreplace
I hope it's what you're lookin for...
ciao
Originally posted by amitpComment
-
Thank you very much for the code. But this code doesn't replace the string. I don't know what it is doing but it is increasing the file size. i want to open a template RTF file and search for a particular string and then replace it with an another string and save the file with another name with same format. I'll give the RTF file. Below one is template RTF file from which i hav to search for a string.
There r fileld like "<<s_naam>> " present in the file and i need to replace it with another string or value. Rest all should remain same. Needing help in this.
{\rtf1\ansi \deff4\deflang1 033{\fonttbl{\f 4\froman\fchars et0\fprq2 Times New Roman;}{\f5\fsw iss\fcharset0\f prq2 Arial;}{\f70\fs wiss\fcharset0\ fprq2 KPN Sans{\*\falt Arial};}}{\colo rtbl;\red0\gree n0\blue0;\red0\ green0\blue255;
\red0\green255\ blue255;\red0\g reen255\blue0;\ red255\green0\b lue255;\red255\ green0\blue0;\r ed255\green255\ blue0;\red255\g reen255\blue255 ;\red0\green0\b lue128;\red0\gr een128\blue128; \red0\green128\ blue0;\red128\g reen0\blue128;\ red128\green0\b lue0;
\red128\green12 8\blue0;\red128 \green128\blue1 28;\red192\gree n192\blue192;}{ \stylesheet{\no widctlpar \f4\fs20\lang20 57 \snext0 Normal;}{\s1\sb 240\sa60\keepn\ nowidctlpar \b\f5\fs28\lang 2057\kerning28 \sbasedon0\snex t0 heading 1;}{
\s2\sb240\sa60\ keepn\nowidctlp ar \b\i\f5\lang205 7 \sbasedon0\snex t0 heading 2;}{\*\cs10 \additive Default Paragraph Font;}{\s15\now idctlpar\tqc\tx 4536\tqr\tx9072 \f4\fs20\lang20 57 \sbasedon0\snex t15 header;}{\*\cs1 6 \additive\f5\fs 16 \sbasedon10
CellTitel;}{\*\ cs17 \additive\fs22 \sbasedon16 CellTitelGroot; }{\s18\nowidctl par\tqc\tx4536\ tqr\tx9072 \f4\fs20\lang20 57 \sbasedon0\snex t18 footer;}{\s19\s b120\sa120\nowi dctlpar \b\f4\fs20\lang 2057 \sbasedon0\snex t0 caption;}}{\inf o{\title Klantgegevens}
{\author T-Werkplek}{\oper ator T-Werkplek}{\crea tim\yr1998\mo6\ dy10\hr14\min36 }{\revtim\yr200 2\mo9\dy19\hr11 \min22}{\printi m\yr1997\mo3\dy 11\hr14\min10}{ \version2}{\edm ins0}{\nofpages 1}{\nofwords126 }{\nofchars720} {\*\company PTT Telecom I&AT}{\vern5739 5}}
\paperw11907\pa perh16840\margl 510\margr510\ma rgt431\margb431 \widowctrl\ftnb j\aenddoc\hyphh otz425\hyphcaps 0\formshade \fet0\sectd \psz9\linex0\he adery284\footer y369\colsx709\e ndnhere {\*\pnseclvl1\p nucrm\pnstart1\ pnindent720\pnh ang{\pntxta .}}
{\*\pnseclvl2\p nucltr\pnstart1 \pnindent720\pn hang{\pntxta .}}{\*\pnseclvl 3\pndec\pnstart 1\pnindent720\p nhang{\pntxta .}}{\*\pnseclvl 4\pnlcltr\pnsta rt1\pnindent720 \pnhang{\pntxta )}}{\*\pnseclvl 5\pndec\pnstart 1\pnindent720\p nhang{\pntxtb (}{\pntxta )}}
{\*\pnseclvl6\p nlcltr\pnstart1 \pnindent720\pn hang{\pntxtb (}{\pntxta )}}{\*\pnseclvl 7\pnlcrm\pnstar t1\pnindent720\ pnhang{\pntxtb (}{\pntxta )}}{\*\pnseclvl 8\pnlcltr\pnsta rt1\pnindent720 \pnhang{\pntxtb (}{\pntxta )}}{\*\pnseclvl 9
\pnlcrm\pnstart 1\pnindent720\p nhang{\pntxtb (}{\pntxta )}}\trowd \trgaph56\trlef t-56 \clbrdrt\brdrs\ brdrw15 \clshdng2000 \cellx1362\clbr drt\brdrs\brdrw 15 \clbrdrb\brdrs\ brdrw15 \cellx6036\clbr drt\brdrs\brdrw 15 \cellx6283\clbr drt\brdrs\brdrw 15 \clbrdrb
\brdrs\brdrw15 \cellx11143 \pard\plain \keepn\widctlpa r\intbl \f4\fs20\lang20 57 {\cs16\b\f70\fs 16\lang19 Klantgegevens\c ell }{\cs16\f70\fs1 4\lang19 Naam en voorletters of bedrijfsnaam contractant
\par }{\field\flddir ty{\*\fldinst {\i\f70\fs14 MACROBUTTON QueryVeld <<s_naam>> }}{\fldrslt }}{\cs16\f70\fs 14\lang19 \cell \cell Naam en voorletters of bedrijfsnaam gebruiker
\par }{\field\flddir ty{\*\fldinst {\i\f70\fs14 MACROBUTTON QueryVeld <<s_naam_gebr >> }}{\fldrslt }}{\cs16\f70\fs 14\lang19 \cell }\pard \widctlpar\intb l {\cs16\b\f70\la ng19 \row }\trowd \trgaph56\trlef t-56 \clshdng2000 \cellx1362\clbr drt\brdrs\brdrw 15 \clbrdrb
\brdrs\brdrw15 \cellx6036\cell x6283\clbrdrt\b rdrs\brdrw15 \clbrdrb\brdrs\ brdrw15 \cellx11143 \pard \keepn\widctlpa r\intbl {\cs16\b\f70\la ng19 \cell }{\cs16\f70\fs1 4\lang19 Adres}{\cs16\i\ f70\fs14\lang19
\par }{\field\flddir ty{\*\fldinst {\i\f70\fs14 MACROBUTTON QueryVeld <<s_adres>> }}{\fldrslt }}{\cs16\f70\fs 14\lang19 \cell \cell Aansluitadres
\par }{\field\flddir ty{\*\fldinst {\i\f70\fs14 MACROBUTTON QueryVeld <<s_aansluitadr es>> }}{\fldrslt }}{\cs16\f70\fs 14\lang19 \cell }\pard \widctlpar\intb l {\cs16\f70\lang 19 \row }\pard \keepn\widctlpa r\intbl {\cs16\b\f70\la ng19 \cell }{\cs16\f70\fs1 4\lang19
Postcode en woonplaats
\par }{\field\flddir ty{\*\fldinst {\i\f70\fs14 MACROBUTTON QueryVeld <<s_pc_wpl>> }}{\fldrslt }}{\cs16\f70\fs 14\lang19 \cell \cell Postcode en woonplaats
\par }{\field\flddir ty{\*\fldinst {\i\f70\fs14 MACROBUTTON QueryVeld <<s_pc_wpl_gebr >> }}{\fldrslt }}{\cs16\f70\fs 14\lang19 \cell }\pard \widctlpar\intb l {\cs16\f70\lang 19 \row }\trowd \trgaph56\trlef t-56 \clshdng2000 \cellx1362\clbr drt\brdrs\brdrw 15 \clbrdrb
\brdrs\brdrw15 \cellx6036\cell x6283\clbrdrt\b rdrs\brdrw15 \clbrdrb\brdrs\ brdrw15 \cellx8484\clbr drt\brdrs\brdrw 15 \clbrdrb\brdrs\ brdrw15 \cellx11143 \pard \keepn\widctlpa r\intbl {\cs16\b\f70\la ng19 \cell }{\cs16\f70\fs1 4\lang19 Land
\par }{\field\flddir ty{\*\fldinst {\i\f70\fs14 MACROBUTTON QueryVeld <<s_land_zip> > }}{\fldrslt }}{\cs16\f70\fs 14\lang19 \cell \cell Land
\par }{\field\flddir ty{\*\fldinst {\i\f70\fs14 MACROBUTTON QueryVeld <<s_land_zip_ge br>> }}{\fldrslt }}{\cs16\f70\fs 14\lang19 \cell \cell }\pard \widctlpar\intb l {\cs16\f70\lang 19 \row }\trowd \trgaph56\trlef t-56 \clshdng2000 \cellx1362\clbr drt\brdrs\brdrw 15
\clbrdrb\brdrs\ brdrw15 \cellx3925\cell x6036\cellx6283 \clbrdrt\brdrs\ brdrw15 \clbrdrb\brdrs\ brdrw15 \cellx8484\clbr drt\brdrs\brdrw 15 \clbrdrb\brdrs\ brdrw15 \cellx11143 \pard \keepn\widctlpa r\intbl {\cs16\b\f70\la ng19 \cell }{\cs16\f70\fs1 4\lang19
Contactpersoon
\par }{\field\flddir ty{\*\fldinst {\i\f70\fs14 MACROBUTTON QueryVeld <<s_cp>> }}{\fldrslt }}{\cs16\f70\fs 14\lang19 \cell Telefoonnummer
\par }{\field\flddir ty{\*\fldinst {\i\f70\fs14 MACROBUTTON QueryVeld <<s_tel>> }}{\fldrslt }}{\cs16\f70\fs 14\lang19 \cell \cell Contactpersoon
\par }{\field\flddir ty{\*\fldinst {\i\f70\fs14 MACROBUTTON QueryVeld <<s_cp_gebr>> }}{\fldrslt }}{\cs16\f70\fs 14\lang19 \cell Telefoonnummer
\par }{\field\flddir ty{\*\fldinst {\i\f70\fs14 MACROBUTTON QueryVeld <<s_tel_gebr> > }}{\fldrslt }}{\cs16\f70\fs 14\lang19 \cell }\pard \widctlpar\intb l {\cs16\f70\lang 19 \row }\trowd \trgaph56\trlef t-56 \clshdng2000 \cellx1362\clbr drt\brdrs\brdrw 15 \cellx6036
\cellx6283\clbr drt\brdrs\brdrw 15 \cellx11143 \pard \keepn\widctlpa r\intbl {\cs16\b\f70\la ng19 \cell }{\cs16\f70\fs1 4\lang19 Inschr.nr. KVK
\par }{\field\flddir ty{\*\fldinst {\i\f70\fs14 MACROBUTTON QueryVeld <<s_nr_kvk>> }}{\fldrslt }}{\cs16\f70\fs 14\lang19 \cell \cell Nieuw adres bij verhuizing
\par }{\field\flddir ty{\*\fldinst {\i\f70\fs14 MACROBUTTON QueryVeld <<s_adres_verh> > }}{\fldrslt }}{\cs16\f70\fs 14\lang19 \cell }\pard \widctlpar\intb l {\cs16\f70\lang 19 \row }\pard \nowidctlpar
\par }Comment
-
It might be simpler if you forget that it's an RTF file and just treat it as one big chunk of text. Read it into a string, do the scan and replace, then write it out to another file. As long as the output file has the extension .RTF, it should work OK.
Here's some code just off the top of my head...
Code:Dim s As String, L As Long Open "InputFile.Rtf" For binary access read shared as #1 L = Lof(1) s = Space$(L) Get #1,,s Close #1 [I]' Do the scan and replace at this point. ' I'm sure VB code to search and replace within a string ' has been covered plenty of times on TheScripts - try a search.[/I] Open "OutputFile.Rtf" For Binary access write lock write As #1 put #1,,s Close #1
Comment
-
Yes that's easier but what about the format?
I think font stuff (size, font type...) and so on will change if you treat it as text file.
Ehy Killah , did you try to run your code with a particular format (bold, underline and so on)? Is it workin?
However , the code I provided WORKS, but you had to adapt it. I could make a nice Sub which was givin proper results WITHOUT changing the format.I have it at home I will post it at about 18.30.
Bye!
Originally posted by Killer42Comment
-
Ok , maybe 18.30 is too late..This is the Sub I mentioned, below you will find an example showing how to use it. Of course Sfind must be present in the Inputfile and of course you can improve it!
I tried and it WORKS ...format is left unhaltered where Sfind is replaced !!!
Tot ziens amitp !
'-----------------------------------------------------------------------------------------------------------
Sub FindReplace(ByV al Sfind As String, ByVal Sreplace As String, ByVal Inputfile As String, ByVal Outputfile As String)
Set wrdApp = CreateObject("W ord.Application ")
wrdApp.Visible = True
Set wrdDoc = wrdApp.Document s.Open(Inputfil e)
wrdApp.Applicat ion.Selection.F ind.ClearFormat ting
wrdApp.Applicat ion.Selection.F ind.Replacement .ClearFormattin g
With wrdApp.Selectio n.Find
.Text = Sfind
.Replacement.Te xt = Sreplace
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchKashida = False
.MatchDiacritic s = False
.MatchAlefHamza = False
.MatchControl = False
.MatchWildcards = False
.MatchSoundsLik e = False
.MatchAllWordFo rms = False
End With
wrdApp.Applicat ion.Selection.F ind.Execute Replace:=wdRepl aceAll
' Save to ouput file
With wrdDoc
.SaveAs (Outputfile)
.Close ' close the document
End With
wrdApp.Quit ' close the Word application
Set wrdDoc = Nothing
Set wrdApp = Nothing
End Sub
'---------------------------------------------------------------------------------------
' How to use it:
Private Sub CommandButton1_ Click()
Dim wrdApp As Word.Applicatio n
Dim IFile, OFile As String
Dim Sfind, Sreplace
IFile = "\NEW\Input.rtf " ' an existing rtf file in c:\NEW\ where Sfind occurs
OFile = "\NEW\Output.rt f"
Sfind = "ciao" ' string to find
Sreplace = "pippo" ' string to replace
Call FindReplace(Sfi nd, Sreplace, IFile, OFile)
End Sub
'---------------------
Originally posted by amitpComment
-
I haven't tried that code at all - I just typed it straight into the message. If you have code which works, then that's great. :)Originally posted by diSangro
However, if the strings that are being replaced are in the actual text, then the formatting should not be an issue at all. I'm not an expert on RTF format, but consider HTML, or even the simple tags we use here on TheScripts. Let's say I have some text which includes tags to make things bold and underlined. I can do a search and replace on that text, and as long as it doesn't affect the tags, all should be well. Example (just typed in, to illustrate the point)...- Before replace:
make things bold and underlined - After replace:
make things buld and onderloned
Comment
- Before replace:
-
Ok I admit I did underestimate this problem... I didnt get you ment you wanna replace FIELD CODEs (I dont know much about rtf).
So you should off/on field codes after/before replacing.
Then you can replace string; to do that I made another Sub (FieldCode_onof f).
Of course an approach as the Killah suggested can work, but someone says there's a 32k-filesize limit : vb-helper
My apologies ...the previous code is NOT replacing the FIELD CODE string but only text strings in rtf.
However the followin DOES WORK indeed! :-)
(tested with your file, I could replace "<<s_naam>> " with "pippo")
'--------------------------------FieldCode_onoff
Sub FieldCode_onoff (wrdDoc As Variant, onoff As Boolean)
wrdDoc.ActiveWi ndow.View.ShowF ieldCodes = Not wrdDoc.ActiveWi ndow.View.ShowF ieldCodes
wrdDoc.Applicat ion.DisplayStat usBar = True
wrdDoc.Applicat ion.ShowWindows InTaskbar = True
wrdDoc.Applicat ion.ShowStartup Dialog = True
With wrdDoc.ActiveWi ndow
.DisplayHorizon talScrollBar = True
.DisplayVertica lScrollBar = True
.DisplayLeftScr ollBar = False
.StyleAreaWidth = InchesToPoints( 0)
.DisplayVertica lRuler = True
.DisplayRightRu ler = False
.DisplayScreenT ips = True
With wrdDoc.ActiveWi ndow.View
.ShowAnimation = True
.Draft = False
.WrapToWindow = False
.ShowPicturePla ceHolders = False
.ShowFieldCodes = onoff
.ShowBookmarks = False
.FieldShading = wdFieldShadingW henSelected
.ShowTabs = False
.ShowSpaces = False
.ShowParagraphs = False
.ShowHyphens = False
.ShowHiddenText = False
.ShowAll = False
.ShowDrawings = True
.ShowObjectAnch ors = False
.ShowTextBounda ries = False
.ShowHighlight = True
.DisplayPageBou ndaries = True
.DisplaySmartTa gs = True
End With
End With
End Sub
'------------------------------------------------------------------------------
Now you have to call this Sub twice in Find_Replace, first you set FIELDCODEs visible (off), to do this after :
Set wrdDoc = wrdApp.Document s.Open(InputFil e)
put :
Call FieldCode_onoff (wrdDoc, True)
Secondly , BEFORE the line:
With wrdDoc
put:
Call FieldCode_onoff (wrdDoc, False)
This will put FIELDCODEs non-visible (on again)
Note: output file increase of size cause the VBcode will be saved within the file.
To the Killah: I'm sure with your approach can be much easier ,but I wanted to learn how drive Word from VB.
Bye All !
Originally posted by diSangroComment
-
No, I'm talking about replacing pieces of text within the string, and simply ignoring the tags/codes/whatever. The tags are simply more text. As long as you don't do anything to them, I expect they will continue to work OK. I could be wrong, of course - as I said, I'm not expert in RTF.Originally posted by diSangro
If you can avoid all this, I believe it will make your code much simpler.Originally posted by diSangro
Only if you're using the LEN= clause, and I can't imagine why you would. (Until now, I wasn't aware that you could use it with Binary). Reading a chunk of data from a binary file is only limited by the available memory. I have dealt with hundreds of MB at a time in some cases.Originally posted by diSangroComment
-
Thank you very much for your help. It's working perfectly fine.Comment
-
I'm glad to hear that.Originally posted by amitp
Just out of curiosity, what technique did you end up using? As I recall, there were a few ideas under discussion.Comment
-
I've to append some MS Word 2003 documents to a single document. My word documents contain tables. Each document contains a single table. My code appended the files but there remains some spaces between the tables. Why these spaces comes. I want that the next word document should start at the EOF of immidiate above. I don't know much 'bout WORD 2003 . Could any one suggest me to handle the issue. I'm providing the code.
Dim wrdApp As Word.Applicatio n
Dim wrdDoc As New Word.Document
Dim file1, file2, file3, docName As String
file1 = "C:\Test.rt f"
file2 = "C:\Q0000001.rt f"
file3 = "C:\Q0000002.rt f"
Set wrdApp = CreateObject("W ord.Application ")
wrdApp.Visible = False
Set wrdDoc = wrdApp.Document s.Add(file1)
wrdDoc.Applicat ion.Selection.I nsertFile (file2)
wrdDoc.Applicat ion.Selection.I nsertBreak (WdBreakType.wd LineBreak)
wrdDoc.Applicat ion.Selection.I nsertFile (file3)
wrdDoc.Applicat ion.Selection.I nsertBreak (WdBreakType.wd LineBreak)
wrdDoc.SaveAs (file1)
wrdDoc.CloseComment
Comment