Convert MS Word to Excel
 

 'VBA code for Paper "Impact of Sarbanes-Oxley Act on Target CEO Trading Behaviors"

'Coded by Fei Pan

'Sep. 2008


Sub WordToExcel()

' Clear all the old contents: clear existing worksheets and clear Sheet1

Call Sheets_Delete

Dim MyWd As Object

Dim Newworksheet As Worksheet

Dim Filename As String

For I = 1 To 3

' Change the file address name according to the location you save

    Filename = "C:\Documents and Settings\fei pan\My Documents\My Paper\Journal\Insider Trading\Data Word\XICORINC4_" & I & ".rtf"

    If I = 1 Then

        Set MyWd = GetObject(Filename)

        MyWd.ActiveWindow.Selection.WholeStory

        MyWd.ActiveWindow.Selection.Copy

        Sheets(I).Range("A1").PasteSpecial xlPasteValues

        MyWd.Close

    End If

    If I > 1 Then

        ThisWorkbook.Sheets.Add After:=Sheets(Worksheets.Count), Count:=1, Type:=xlWorksheet

        Set MyWd = GetObject(Filename)

        MyWd.ActiveWindow.Selection.WholeStory

        MyWd.ActiveWindow.Selection.Copy

        Sheets(I).Range("A1").PasteSpecial xlPasteValues

        MyWd.Close

    End If

Next I

End Sub


Private Sub Sheets_Delete()

Dim I As Integer

Application.ScreenUpdating = False

Application.DisplayAlerts = False

For I = ActiveWorkbook.Worksheets.Count To 1 Step -1

      If Worksheets(I).Name <> "Sheet1" Then _

         Worksheets(I).Delete

Next I

Application.ScreenUpdating = True

Application.DisplayAlerts = True

Sheets(1).Range("A:X").Value = ""

End Sub