'Word2BBCode-Converter v0.1, June 2, 2006
'Matthew Kruer
'Original Version by InfPro
'License: GPL: Feel free to use and modify. Keep the credits and do not sell.
'Code reduction by Tom Liehr, December 2012

   Sub Word2BBCode()
       Application.ScreenUpdating = False
       ConvertItalic
       ConvertBold
       ConvertUnderline
       ActiveDocument.Content.Copy
       Application.ScreenUpdating = True
   End Sub

   Private Sub ConvertBold()
       ActiveDocument.Select
       With Selection.Find
           .ClearFormatting
           .Font.Bold = True
           .Text = ""
           .Format = True
           .MatchCase = False
           .MatchWholeWord = False
           .MatchWildcards = False
           .MatchSoundsLike = False
           .MatchAllWordForms = False
           .Forward = True
           .Wrap = wdFindContinue

           	Do While .Execute
               With Selection
                   If InStr(1, .Text, vbCr) Then
                              .Font.Bold = False
                        .Collapse
                        .MoveEndUntil vbCr
                    End If
                    If Not .Text = vbCr Then
                        .InsertBefore "[b]"
                        .InsertAfter "[/b]"
                    End If
                    .Font.Bold = False
                End With
            Loop
        End With
    End Sub

    Private Sub ConvertItalic()
        ActiveDocument.Select
        With Selection.Find
            .ClearFormatting
            .Font.Italic = True
            .Text = ""
            .Format = True
            .MatchCase = False
            .MatchWholeWord = False
            .MatchWildcards = False
            .MatchSoundsLike = False
            .MatchAllWordForms = False
            .Forward = True
            .Wrap = wdFindContinue
            Do While .Execute
                With Selection
                    If InStr(1, .Text, vbCr) Then
                       .Font.Italic = False
                       .Collapse
                       .MoveEndUntil vbCr
                   End If
                   If Not .Text = vbCr Then
                       .InsertBefore "[i]"
                       .InsertAfter "[/i]"
                   End If
                   .Font.Italic = False
               End With
           Loop
       End With
   End Sub


   Private Sub ConvertUnderline()
       ActiveDocument.Select
       With Selection.Find
           .ClearFormatting
           .Font.Underline = True
           .Text = ""
           .Format = True
           .MatchCase = False
           .MatchWholeWord = False
           .MatchWildcards = False
           .MatchSoundsLike = False
           .MatchAllWordForms = False
           .Forward = True
           .Wrap = wdFindContinue
           Do While .Execute
               With Selection
                   If InStr(1, .Text, vbCr) Then
                        .Font.Underline = False
                        .Collapse
                        .MoveEndUntil vbCr
                    End If
                    If Not .Text = vbCr Then
                        .InsertBefore "[u]"
                        .InsertAfter "[/u]"
                    End If
                    .Font.Underline = False
                End With
            Loop
        End With
    End Sub