I just created a macro for creating a list in Word. The problem I am having is that it will not cut the selections.
Sub EditEmailList()
Dim List As String 'variable name goes here As datatype
strSearchText = " ("
TopOfFile
SearchDown List 'variable name
While Selection.Find.Found
Selection.MoveRight 'use IntelliSense (type a dot "." after "Selection") to move the cursor to the right
Selection.TypeBackspace 'use IntelliSense to make program type a backspace
Repeat
Selection.TypeText Chr(9)
Selection.MoveLeft 'use IntelliSense to move the cursor to the left
Selection.Extend 'use IntelliSense to extend the selection
SearchUp " "
If Selection.Find.Found = True Then
Selection.MoveRight
Selection.EscapeKey 'use IntelliSense to perform the same action as the Esc key on the keyboard
Selection.Cut 'use IntelliSense to cut the selection
Selection.TypeBackspace 'use IntelliSense to type a backspace
Selection.MoveUp Unit:=wdParagraph
Selection.PasteAppendTable 'use IntelliSense to paste the clipboard content
Selection.TypeText Chr(9)
Else
End
End If
Selection.MoveDown 'use IntelliSense to move down one paragraph
SearchDown List
Wend
Selection.WholeStory
Selection.ParagraphFormat.Reset
Selection.ConvertToTable Separator:=wdSeparateByTabs, NumColumns:=3, NumRows:=6
Selection.Tables(1).AutoFitBehavior (wdAutoFitContent)
TopOfFile
Selection.InsertRowsAbove 1
Selection.Font.Bold = True
Selection.ParagraphFormat.Alignment = wdAlignParagraphCenter
Selection.TypeText Text:="LastName"
Selection.MoveRight Unit:=wdCell
Selection.TypeText Text:="FirstName"
Selection.MoveRight Unit:=wdCell
Selection.TypeText Text:="Email"
TopOfFile
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
.Text = ")"
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindContinue
.Format = False
End With
Selection.Find.Execute Replace:=wdReplaceAll
'following is message output telling user what the program did
MsgBox "[FirstName LastName (e-mail address)]" & " for " & intCnt & " different records"
End Sub
Sub TopOfFile()
Selection.HomeKey Unit:=wdStory
End Sub
Sub SearchDown(strPassedText As String)
Selection.Find.Text = strPassedText
Selection.Find.Forward = True
Selection.Find.Wrap = wdFindStop
Selection.Find.MatchCase = False
Selection.Find.MatchWholeWord = False
Selection.Find.Format = False
Selection.Find.Execute
End Sub
Sub SearchUp(strPassedText As String)
Selection.Find.Text = strPassedText
Selection.Find.Forward = False
Selection.Find.Wrap = wdFindStop
Selection.Find.MatchCase = False
Selection.Find.MatchWholeWord = False
Selection.Find.Format = False
Selection.Find.Execute
End Sub
