How can I parse an outlook table using vba, to automatically update quickparts? -
i have tried find answer question without success, apologies if has been asked before.
i have outlook message table containing table, want parse using vba create or update quick part entries.
the table looks :
+-----+--------------+--------------+ | xxx | | b | +-----+--------------+--------------+ | 1 | samplea1 | sampleb1 | +-----+--------------+--------------+ | 2 | samplea2 | sampleb2 | +-----+--------------+--------------+ | 3 | samplea3 | sampleb3 | +-----+--------------+--------------+
my objective generate quick parts id example "xxxa1" , corresponding text "samplea1".
the id constructed first cell of table , row , column headers, , values corresponding cell contents.
i hope clear.
any appreciated. chris
ok, i've managed read table, can't find how access quickparts store i've read.
my code far looks this.
sub parsetable2quickparts() dim objol outlook.application dim objns outlook.namespace dim objdoc object 'word.document dim objsel object 'word.selection dim ctitle string dim acrow(10) string dim nrow integer dim accol(10) string dim ncol integer dim acvalues(10, 10) string on error resume next set objol = application if objol.activeinspector.editortype = oleditorword set objdoc = objol.activeinspector.wordeditor set objns = objol.session set objsel = objdoc.windows(1).selection objsel.move wdstory, -1 objsel.move wdtable, 1 objsel.expand 12 ctitle = left(objsel.text, len(objsel.text) - 2) ncol = 2 3 objsel.move wdrow, 0 objsel.move wdcell, 1 objsel.expand 12 accol(ncol) = left(objsel.text, len(objsel.text) - 2) next nrow = 2 4 objsel.move wdrow, 1 objsel.move wdcell, 0 objsel.expand 12 acrow(nrow) = left(objsel.text, len(objsel.text) - 2) next objsel.move wdstory, -1 objsel.move wdtable, 1 nrow = 2 4 objsel.move wdrow, 1 ncol = 2 3 objsel.move wdcell, 1 objsel.expand 12 acvalues(ncol, nrow) = left(objsel.text, len(objsel.text) - 2) next next objsel.move wdstory, 1 nrow = 2 4 ncol = 2 3 objsel.insertafter ctitle & accol(ncol) & acrow(nrow) & " => " & acvalues(ncol, nrow) & vbcrlf next next end if set objol = nothing set objns = nothing end sub
i need replace final nested loops store i've read rather dump message. can point me in right direction ?
Comments
Post a Comment