Sub Word2FlexWiki() 
    
    Application.ScreenUpdating = False 
    
    ConvertReservedChars 
    
    ConvertH1 
    ConvertH2 
    ConvertH3 
    
    ConvertItalic 
    ConvertBold 
    ConvertUnderline 
    ConvertStrikeThrough 
    
    ConvertLists 
    ConvertTables 
    
    ' Copy to clipboard 
    ActiveDocument.Content.Copy 
    
    Application.ScreenUpdating = True 
End Sub 

Private Sub ConvertReservedChars() 

    ActiveDocument.Select 
    
    With Selection.Range.Find 
        ' FlexWiki treats the '+' as markup for underlining 
        ' in some circumstances, so lets just make sure! 
        .Text = "+" 
        .Replacement.Text = "+++" 
        .Wrap = wdFindContinue 
        .Execute Replace:=wdReplaceAll 
        
        ' FlexWiki uses square brackets to force some text 
        ' to be treated as a link 
        .Text = "[" 
        .Replacement.Text = "{" 
        .Wrap = wdFindContinue 
        .Execute Replace:=wdReplaceAll 
        
        .Text = "]" 
        .Replacement.Text = "}" 
        .Wrap = wdFindContinue 
        .Execute Replace:=wdReplaceAll 
    End With 

        
End Sub 
Private Sub ConvertH1() 
    Dim normalStyle As Style 
    Set normalStyle = ActiveDocument.Styles(wdStyleNormal) 
    
    ActiveDocument.Select 
    
    With Selection.Find 
    
        .ClearFormatting 
        .Style = ActiveDocument.Styles(wdStyleHeading1) 
        .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 
                    ' Just process the chunk before any newline characters 
                    ' We'll pick-up the rest with the next search 
                    .Collapse 
                    .MoveEndUntil vbCr 
                End If 
                                       
                ' Don't bother to markup newline characters (prevents a loop, as well) 
                If Not .Text = vbCr Then 
                    .InsertBefore "!" 
                End If 
                
                .Style = normalStyle 
            End With 
        Loop 
    End With 
End Sub 

Private Sub ConvertH2() 
    Dim normalStyle As Style 
    Set normalStyle = ActiveDocument.Styles(wdStyleNormal) 
    
    ActiveDocument.Select 
    
    With Selection.Find 
    
        .ClearFormatting 
        .Style = ActiveDocument.Styles(wdStyleHeading2) 
        .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 
                    ' Just process the chunk before any newline characters 
                    ' We'll pick-up the rest with the next search 
                    .Collapse 
                    .MoveEndUntil vbCr 
                End If 
                                       
                ' Don't bother to markup newline characters (prevents a loop, as well) 
                If Not .Text = vbCr Then 
                    .InsertBefore "!!" 
                End If 
                
                .Style = normalStyle 
            End With 
        Loop 
    End With 
End Sub 

Private Sub ConvertH3() 
    Dim normalStyle As Style 
    Set normalStyle = ActiveDocument.Styles(wdStyleNormal) 
    
    ActiveDocument.Select 
    
    With Selection.Find 
    
        .ClearFormatting 
        .Style = ActiveDocument.Styles(wdStyleHeading3) 
        .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 
                    ' Just process the chunk before any newline characters 
                    ' We'll pick-up the rest with the next search 
                    .Collapse 
                    .MoveEndUntil vbCr 
                End If 
                                       
                ' Don't bother to markup newline characters (prevents a loop, as well) 
                If Not .Text = vbCr Then 
                    .InsertBefore "!!!" 
                End If 
                
                .Style = normalStyle 
            End With 
        Loop 
    End With 
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 
                    ' Just process the chunk before any newline characters 
                    ' We'll pick-up the rest with the next search 
                    .Collapse 
                    .MoveEndUntil vbCr 
                End If 
                                       
                ' Don't bother to markup newline characters (prevents a loop, as well) 
                ' Word sometimes seems to find the last match twice, which 
                ' results in the affected text being marked-up twice 
                If (Not .Text = vbCr) And (.Font.Bold = True) Then 
                    .InsertBefore "'''" 
                    .InsertAfter "'''" 
                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 
                    ' Just process the chunk before any newline characters 
                    ' We'll pick-up the rest with the next search 
                    .Collapse 
                    .MoveEndUntil vbCr 
                End If 
                                       
                ' Don't bother to markup newline characters (prevents a loop, as well) 
                ' Word sometimes seems to find the last match twice, which 
                ' results in the affected text being marked-up twice 
                If (Not .Text = vbCr) And (.Font.Italic = True) Then 
                    .InsertBefore "''" 
                    .InsertAfter "''" 
                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 
                    ' Just process the chunk before any newline characters 
                    ' We'll pick-up the rest with the next search 
                    .Collapse 
                    .MoveEndUntil vbCr 
                End If 
                                       
                ' Don't bother to markup newline characters (prevents a loop, as well) 
                ' Word sometimes seems to find the last match twice, which 
                ' results in the affected text being marked-up twice 
                If (Not .Text = vbCr) And (.Font.Underline = True) Then 
                    .InsertBefore "+" 
                    .InsertAfter "+" 
                End If 
                
                .Font.Underline = False 
            End With 
        Loop 
    End With 
End Sub 

Private Sub ConvertStrikeThrough() 
    ActiveDocument.Select 
    
    With Selection.Find 
    
        .ClearFormatting 
        .Font.StrikeThrough = 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 
                    ' Just process the chunk before any newline characters 
                    ' We'll pick-up the rest with the next search 
                    .Collapse 
                    .MoveEndUntil vbCr 
                End If 
                                       
                ' Don't bother to markup newline characters (prevents a loop, as well) 
                ' Word sometimes seems to find the last match twice, which 
                ' results in the affected text being marked-up twice 
                If (Not .Text = vbCr) And (.Font.StrikeThrough = True) Then 
                    .InsertBefore "-" 
                    .InsertAfter "-" 
                End If 
                
                .Font.StrikeThrough = False 
            End With 
        Loop 
    End With 
End Sub 



Private Sub ConvertLists() 
    Dim para As Paragraph 
    For Each para In ActiveDocument.ListParagraphs 
        With para.Range 
            If .ListFormat.ListType = wdListBullet Then 
                .InsertBefore "        *" 
            Else 
                .InsertBefore "        1." 
            End If 
            
            .ListFormat.RemoveNumbers 
        End With 
    Next para 
End Sub 

Private Sub ConvertTables() 
    Dim thisTable As Table 
    Dim thisCol As Column 
    Dim thisRow As Row 
    Dim thisCell As Cell 
    
    For Each thisTable In ActiveDocument.Tables 
        With thisTable 
        For Each thisRow In thisTable.Rows 
            With thisRow 
            .Range.InsertBefore "||" 
            '.Range.InsertAfter "||" 
            
            For Each thisCell In thisRow.Cells 
                With thisCell 
                .Range.InsertAfter "||" 
                End With 
            Next thisCell 
            
            .ConvertToText " " 
            End With 
        Next thisRow 
        End With 
    Next thisTable 
End Sub