Re: [Mediawiki-l] Converting MS Word to Wiki?

Ok attachment is not working. Sorry I'm new here.

Then just copy below. In de VB editor in Word right click on the module and add a new module and paste the text. Then export it.

======

Sub Word2Wiki()

Application.ScreenUpdating = False

ReplaceQuotes WikiEscapeChars WikiConvertHyperlinks

WikiConvertH1 WikiConvertH2 WikiConvertH3 WikiConvertH4 WikiConvertH5

WikiConvertItalic WikiConvertBold WikiConvertUnderline WikiConvertStrikeThrough WikiConvertSuperscript WikiConvertSubscript

WikiConvertLists WikiConvertTables

WikiSaveAsHTMLAndConvertImages

' Copy to clipboard ActiveDocument.Content.Copy

Application.ScreenUpdating = True End Sub

Private Sub WikiConvertH1() ReplaceHeading wdStyleHeading1, "==" End Sub

Private Sub WikiConvertH2() ReplaceHeading wdStyleHeading2, "===" End Sub

Private Sub WikiConvertH3() ReplaceHeading wdStyleHeading3, "====" End Sub

Private Sub WikiConvertH4() ReplaceHeading wdStyleHeading4, "=====" End Sub

Private Sub WikiConvertH5() ReplaceHeading wdStyleHeading5, "======" End Sub

Private Sub WikiConvertBold() 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 Len(.Text) > 1 And 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 "'''" .InsertAfter "'''" End If

.Style = ActiveDocument.Styles("Default Paragraph Font") .Font.Bold = False End With Loop End With End Sub

Private Sub WikiConvertItalic() 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 Len(.Text) > 1 And 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 "''" .InsertAfter "''" End If

.Style = ActiveDocument.Styles("Default Paragraph Font") .Font.Italic = False End With Loop End With End Sub

Private Sub WikiConvertUnderline() 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 Len(.Text) > 1 And 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 "<u>" .InsertAfter "</u>" End If

.Style = ActiveDocument.Styles("Default Paragraph Font") .Font.Underline = False End With Loop End With End Sub

Private Sub WikiConvertStrikeThrough() 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 Len(.Text) > 1 And 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 "<strike>" .InsertAfter "</strike>" End If

.Style = ActiveDocument.Styles("Default Paragraph Font") .Font.StrikeThrough = False End With Loop End With End Sub

Private Sub WikiConvertSuperscript() ActiveDocument.Select

With Selection.Find

.ClearFormatting .Font.Superscript = True .Text = ""

.Format = True .MatchCase = False .MatchWholeWord = False .MatchWildcards = False .MatchSoundsLike = False .MatchAllWordForms = False

.Forward = True .Wrap = wdFindContinue

Do While .Execute With Selection .Text = Trim(.Text) If Len(.Text) > 1 And 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 "^{" .InsertAfter "}" End If

.Style = ActiveDocument.Styles("Default Paragraph Font") .Font.Superscript = False End With Loop End With End Sub

Private Sub WikiConvertSubscript() ActiveDocument.Select

With Selection.Find

.ClearFormatting .Font.Subscript = True .Text = ""

.Format = True .MatchCase = False .MatchWholeWord = False .MatchWildcards = False .MatchSoundsLike = False .MatchAllWordForms = False

.Forward = True .Wrap = wdFindContinue

Do While .Execute With Selection .Text = Trim(.Text) If Len(.Text) > 1 And 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 "_{" .InsertAfter "}" End If

.Style = ActiveDocument.Styles("Default Paragraph Font") .Font.Subscript = False End With Loop End With End Sub

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

Private Sub WikiConvertTables() Dim thisTable As Table Dim thisRow As Row Dim thisCell As Cell Dim ElRango As Object For Each thisTable In ActiveDocument.Tables With thisTable For Each thisCell In thisTable.Range.Cells thisCell.Range.InsertBefore "|" Next thisCell For Each thisRow In .Rows thisRow.Range.InsertBefore Chr(11) & "|-" & Chr(11) If thisRow.Index = .Rows.Count Then 'Cerramos la tabla al final thisRow.Range.InsertAfter Chr(11) & "|}" & Chr(11) End If If thisRow.Index = 1 Then thisRow.Range.InsertBefore "{| border='1'" End If Next thisRow

Set ElRango = .ConvertToText(Separator:="|") With ElRango.Find .ClearFormatting .Text = "^p" With .Replacement .ClearFormatting .Text = "" End With .Execute Replace:=wdReplaceAll End With End With Next thisTable End Sub

Private Sub WikiConvertHyperlinks() Dim hyperCount As Integer

hyperCount = ActiveDocument.Hyperlinks.Count

For i = 1 To hyperCount With ActiveDocument.Hyperlinks(1) Dim addr As String addr = .Address .Delete .Range.InsertBefore "[" .Range.InsertAfter "|" & addr & "]" End With Next i End Sub

' Replace all smart quotes with their dumb equivalents Private Sub ReplaceQuotes() Dim quotes As Boolean quotes = Options.AutoFormatAsYouTypeReplaceQuotes Options.AutoFormatAsYouTypeReplaceQuotes = False ReplaceString ChrW(8220), """" ReplaceString ChrW(8221), """" ReplaceString "'", "'" ReplaceString "'", "'" Options.AutoFormatAsYouTypeReplaceQuotes = quotes End Sub

Private Sub WikiEscapeChars() EscapeCharacter "*" EscapeCharacter "" EscapeCharacter "" EscapeCharacter "" EscapeCharacter "{" EscapeCharacter "}" EscapeCharacter "[" EscapeCharacter "]" EscapeCharacter "~" EscapeCharacter "^^" EscapeCharacter "|" End Sub

Private Function ReplaceHeading(styleHeading As String, headerPrefix As String) Dim normalStyle As Style Set normalStyle = ActiveDocument.Styles(wdStyleNormal)

ActiveDocument.Select

With Selection.Find

.ClearFormatting .Style = ActiveDocument.Styles(styleHeading) .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 headerPrefix .InsertBefore vbCr .InsertAfter headerPrefix End If

.Style = normalStyle End With Loop End With End Function

Private Function EscapeCharacter(char As String) ReplaceString char, "" & char End Function

Private Function ReplaceString(findStr As String, replacementStr As String) Selection.Find.ClearFormatting Selection.Find.Replacement.ClearFormatting With Selection.Find .Text = findStr .Replacement.Text = replacementStr .Forward = True .Wrap = wdFindContinue .Format = False .MatchCase = False .MatchWholeWord = False .MatchWildcards = False .MatchSoundsLike = False .MatchAllWordForms = False End With Selection.Find.Execute Replace:=wdReplaceAll End Function

Private Sub WikiSaveAsHTMLAndConvertImages() Dim s As shape For Each s In ActiveDocument.Shapes If s.Type = msoPicture Then s.ConvertToInlineShape End If Next FileName = ActiveDocument.Path + "" + ActiveDocument.Name FolderName = FileName + "_files"

ActiveDocument.SaveAs FileName:=FileName + ".htm", _ FileFormat:=wdFormatFilteredHTML, LockComments:=False, Password:="", _ AddToRecentFiles:=True, WritePassword:="", ReadOnlyRecommended:=False, _ EmbedTrueTypeFonts:=False, SaveNativePictureFormat:=False, SaveFormsData _ :=False, SaveAsAOCELetter:=False

Set fs = CreateObject("Scripting.FileSystemObject") If fs.FolderExists(FolderName) Then Set f = fs.GetFolder(FolderName)

Dim iShape As InlineShape Set fc = f.Files i = 1 For Each f In fc If i <= ActiveDocument.InlineShapes.Count Then Set iShape = ActiveDocument.InlineShapes.Item(i) iShape.Range.InsertBefore "[[Afbeelding:" + f.Name & "]]" i = i + 1 End If Next

Shell "explorer.exe " + FileName + "_files", vbNormalFocus End If End Sub =======