Word M.M. 5163 labels format

[MikeL91]

I have a document that is a mail-merged file in a label format (5163), and I need to convert it back into a database I can use... either into excell or dbase. I tried save as dos-text, but is is pretty unusable.

any ideas / tricks?

thanks -Mike

 

[Dreamboat]

Yuk, Mike.

Download my "All About Tables" document. In there, I show you how to do this. It can be tedious.

http://www.thewordexpert.com/word.htm#AllAboutTables

Anne Troy
Dreamboat@TheWordExpert.com
Anne@MrExcel.com

 

[MikeL91]

Yuk is right Anne, luckily it does not happen very often. I wish people were more educated about data

Thanks for you response, I am hitting that link now.

 

[Dreamboat]

Somewhere....somewhere....I have the code that'll do this for you. Is there lots? The daughter gets married Sunday and I'm way busy, but I could look after that for that code.
Anne Troy
Dreamboat@TheWordExpert.com
Anne@MrExcel.com

 

[Dreamboat]

I remember who wrote it and just emailed for it again. We'll see. It was REALLY sweet! Anne Troy
Dreamboat@TheWordExpert.com
Anne@MrExcel.com

 

[MikeL91]

Thanks Anne, for all this help. I get them all the time, some times i can convert them to text, bring them into text editors, and switch to hex mode and do tricky replace all commands until i get it into something that resembles a database, but this one is real tough. There is really no uniformity once i save it out of word. That code will be cool. I thank again.

-Mike

 

[MikeL91]

Thanks Anne, for all this help. I get them all the time, some times i can convert them to text, bring them into text editors, and switch to hex mode and do tricky replace all commands until i get it into something that resembles a database, but this one is real tough. There is really no uniformity once i save it out of word. That code will be cool. I thank again.

-Mike

 

[Dreamboat]

I will soon put this code up at

http://www.TheWordExpert.com

amd

http://www/TheOfficeExperts.com

with complete instructions.

Sub DataSorcerer()
'
' Created by: Tagger of

http://www.TheOfficeExperts.com/forum.htm

'
' This code will convert preexisting mailing labels into
' a functional data table

Dim tbl As Table 'Table object
Dim x As Integer, y As Integer 'Counters
Dim intRows As Integer 'Total rows in table
Dim intCols As Integer 'Total Columns in table
Dim intGotVal As Integer 'Test for blank cells

Application.ScreenUpdating = False

'Select Entire Document and replace all line breaks
'with temporary place holder
Selection.WholeStory
With Selection.Find
.Text = "^p"
.Replacement.Text = &quot;<REPLACEMENT>&quot;
End With
Selection.Find.Execute Replace:=wdReplaceAll

Selection.WholeStory
With Selection.Find
.Text = &quot;^l&quot;
.Replacement.Text = &quot;<REPLACEMENT>&quot;
End With
Selection.Find.Execute Replace:=wdReplaceAll

'Convert all tables to text w/ paragraph symbols
'used as delimiters
For Each tbl In ActiveDocument.Tables
tbl.Select
tbl.Rows.ConvertToText Separator:=wdSeparateByParagraphs
Next tbl

'Remove all section breaks from document
Selection.WholeStory
With Selection.Find
.Text = &quot;^b&quot;
.Replacement.Text = &quot;^p&quot;
End With
Selection.Find.Execute Replace:=wdReplaceAll

'Replace all double line breaks w/ single line breaks
Selection.WholeStory
With Selection.Find
.Text = &quot;^p^p&quot;
.Replacement.Text = &quot;^p&quot;
End With
Selection.Find.Execute Replace:=wdReplaceAll

'Replace temporary place holder w/ tabs to be used
'when text is converted to table
Selection.WholeStory
With Selection.Find
.Text = &quot;<REPLACEMENT>&quot;
.Replacement.Text = &quot;^t&quot;
End With
Selection.Find.Execute Replace:=wdReplaceAll

'Select entire document then convert to table w/ tabs
'as delimiter
Selection.WholeStory
Selection.ConvertToTable Separator:=wdSeparateByTabs

'Count rows and columns and set current table object
intRows = ActiveDocument.Tables(1).Rows.Count
intCols = ActiveDocument.Tables(1).Columns.Count
Set tbl = ActiveDocument.Tables(1)

'Check for and remove blank rows
For x = 1 To intRows
intGotVal = 0
For y = 1 To intCols
If tbl.Cell(x, y).Range.Characters.Count > 1 Then
intGotVal = intGotVal + 1
y = intCols
Else
'Do Nothing
End If
Next y

If intGotVal = 0 Then
tbl.Rows(x).Delete
x = x - 1
Else
'Do Nothing
End If
Next x

'Check for and remove blank columns
For y = 1 To intCols
If y > tbl.Columns.Count Then
y = intCols
Else
intGotVal = 0
For x = 1 To intRows
If tbl.Cell(x, y).Range.Characters.Count > 1 Then
intGotVal = intGotVal + 1
x = intRows
Else
'Do Nothing
End If
Next x

If intGotVal = 0 Then
tbl.Columns.Delete
y = y - 1
Else
'Do Nothing
End If
End If
Next y

'Reset column count and insert blank row
'adding a column heading to each cell
intCols = tbl.Columns.Count
tbl.Rows(1).Select
Selection.InsertRows 1
For y = 1 To intCols
tbl.Cell(1, y).Select
Selection.Text = &quot;Line&quot; & y
Next y

Application.ScreenUpdating = True

End Sub
Anne Troy
Dreamboat@TheWordExpert.com
Anne@MrExcel.com

 

[MikeL91]

Anne, Thanks for the code. I code mostly in VFP right now, where do i put this code? do i create a VB exe from it, or is run from within word?


thanks again,

Mike

 

[MikeL91]

Anne, nevermind... I got it (VB editor)

It worked great!!!! That is some of the coolest code ive seen. I love it. Thanks

-Mike