Sub EVWFileOpenOffice2010CopyPaste()
'
' EVWFileOpenOffice2010 Macro
' Gemaakt door Jaap Bakker - Parthen

    lExit = False
    Do While lExit = False
        With Selection.Find
             .Text = "file:\\"
             .Forward = True
             .Wrap = wdFindContinue
             .Format = True
             .MatchCase = False
             .MatchWholeWord = False
             .MatchWildcards = False
             .MatchSoundsLike = False
             .MatchAllWordForms = False
         End With
         If Selection.Find.Execute = True Then
             Selection.EndKey Unit:=wdLine, Extend:=wdExtend
             cReadString = ""
             cReadString = Trim(Mid(ActiveDocument.ActiveWindow.Selection.Text, 8, Len(ActiveDocument.ActiveWindow.Selection.Text) - 8))
             cReadDoc = ""
             cReadDoc = UCase(Mid(cReadString, Len(cReadString) - 2, 3))
             cReadDoc1 = UCase(Mid(cReadString, Len(cReadString) - 3, 4))
             If cReadDoc = "DOC" Or cReadDoc = "DOT" Or cReadDoc1 = "DOCX" Then
                                  
                 Documents.Open FileName:=cReadString
                 Selection.WholeStory
                 Selection.Copy
                 ActiveWindow.Close
'                WordBasic.EditOfficeClipboard
                 Selection.Paste
                 With Selection.Find
                     .Text = "file:\\" + cReadString
                     .Forward = True
                     .Wrap = False
                     .Format = True
                     .MatchCase = False
                     .MatchWholeWord = False
                     .MatchWildcards = False
                     .MatchSoundsLike = False
                     .MatchAllWordForms = False
                 End With
                 'Nu nog deleten van de string die er stond.
                 If Selection.Find.Execute = True Then
                     Selection.EndKey Unit:=wdLine, Extend:=wdExtend
                     Selection.Delete
'                    Selection.Find.Replacement.Text = ""
'                    Selection.Find.Execute Replace:=wdReplaceOne
                     lExit = False
                 End If
'                 lExit = True
                Else
                 Selection.Find.Replacement.Text = "file://"
                 Selection.Find.Execute Replace:=wdReplaceOne
             End If
         Else
            lExit = True
         End If
    Loop


End Sub


Sub EVWOpenImages()
'
' FileTest Macro
' Macro opgenomen op 20-1-2005 door Jaap Bakker
' Aangepast op  27-08-2014 door Daniel van der Stam
    
    Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    lExit = False
    Do While lExit = False
        With Selection.Find
             .Text = "https://"
             'HTTPS gebruiken we nu ipv HTTP
             .Forward = True
             .Wrap = wdFindContinue
             .Format = True
             .MatchCase = False
             .MatchWholeWord = False
             .MatchWildcards = False
             .MatchSoundsLike = False
             .MatchAllWordForms = False
         End With
         If Selection.Find.Execute = True Then
             Selection.EndKey Unit:=wdLine, Extend:=wdExtend
             cReadstring = ""
             cReadstring = Trim(Mid(ActiveDocument.ActiveWindow.Selection.Text, 1, Len(ActiveDocument.ActiveWindow.Selection.Text) - 1))
             cReadDoc = ""
             cReadDoc = LCase(Mid(cReadstring, Len(cReadstring) - 2, 3))
             If cReadDoc = "bmp" Or cReadDoc = "jpg" Or cReadDoc = "jpeg" Or cReadDoc = "png" Or cReadDoc = "gif" Then
                 Selection.InlineShapes.AddPicture FileName:=cReadstring, LinkToFile:=False, SaveWithDocument:=True
             Else
                 Selection.Find.Replacement.Text = "https:\\"
                 Selection.Find.Execute Replace:=wdReplaceOne
             End If
         Else
            lExit = True
         End If
    Loop

' NU DE PICTURE TEKSTEN WEGHALEN EN DE LEGE CAPTION TEKSTEN WEGHALEN
    Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    lExit = False
    Do While lExit = False
        With Selection.Find
             .Text = "Picture ?:"
             .Forward = True
             .Wrap = wdFindContinue
             .Format = True
             .MatchCase = False
             .MatchWholeWord = False
             .MatchWildcards = True
             .MatchSoundsLike = False
             .MatchAllWordForms = False
         End With
         If Selection.Find.Execute = True Then
             Selection.EndKey Unit:=wdLine, Extend:=wdExtend
             Selection.Find.Replacement.Text = ""
             Selection.Find.Execute Replace:=wdReplaceOne
         Else
            lExit = True
         End If
    Loop


    Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    lExit = False
    Do While lExit = False
        With Selection.Find
             .Text = "Caption ?:"
             .Forward = True
             .Wrap = wdFindContinue
             .Format = True
             .MatchCase = False
             .MatchWholeWord = False
             .MatchWildcards = True
             .MatchSoundsLike = False
             .MatchAllWordForms = False
         End With
         If Selection.Find.Execute = True Then
             Selection.EndKey Unit:=wdLine, Extend:=wdExtend
             cReadstring = ""
             cReadstring = Trim(Mid(ActiveDocument.ActiveWindow.Selection.Text, 1, Len(ActiveDocument.ActiveWindow.Selection.Text) - 1))
             Selection.Find.Replacement.Text = "Picture " + Mid(cReadstring, 8, Len(cReadstring) - 8)
             Selection.Find.Execute Replace:=wdReplaceOne
          Else
            lExit = True
         End If
    Loop

End Sub

Sub EVWOpenImagesHTTPS()
'
' FileTest Macro
' Macro opgenomen op 20-1-2005 door Jaap Bakker
'
    
    Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    lExit = False
    Do While lExit = False
        With Selection.Find
             .Text = "https://"
             .Forward = True
             .Wrap = wdFindContinue
             .Format = True
             .MatchCase = False
             .MatchWholeWord = False
             .MatchWildcards = False
             .MatchSoundsLike = False
             .MatchAllWordForms = False
         End With
         If Selection.Find.Execute = True Then
             Selection.EndKey Unit:=wdLine, Extend:=wdExtend
             cReadstring = ""
             cReadstring = Trim(Mid(ActiveDocument.ActiveWindow.Selection.Text, 1, Len(ActiveDocument.ActiveWindow.Selection.Text) - 1))
             cReadDoc = ""
             cReadDoc = LCase(Mid(cReadstring, Len(cReadstring) - 2, 3))
             If cReadDoc = "bmp" Or cReadDoc = "jpg" Or cReadDoc = "jpeg" Or cReadDoc = "png" Or cReadDoc = "gif" Then
                 Selection.InlineShapes.AddPicture FileName:=cReadstring, LinkToFile:=False, SaveWithDocument:=True
             Else
                 Selection.Find.Replacement.Text = "https:\\"
                 Selection.Find.Execute Replace:=wdReplaceOne
             End If
         Else
            lExit = True
         End If
    Loop

' NU DE PICTURE TEKSTEN WEGHALEN EN DE LEGE CAPTION TEKSTEN WEGHALEN
    Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    lExit = False
    Do While lExit = False
        With Selection.Find
             .Text = "Picture ?:"
             .Forward = True
             .Wrap = wdFindContinue
             .Format = True
             .MatchCase = False
             .MatchWholeWord = False
             .MatchWildcards = True
             .MatchSoundsLike = False
             .MatchAllWordForms = False
         End With
         If Selection.Find.Execute = True Then
             Selection.EndKey Unit:=wdLine, Extend:=wdExtend
             Selection.Find.Replacement.Text = ""
             Selection.Find.Execute Replace:=wdReplaceOne
         Else
            lExit = True
         End If
    Loop


    Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    lExit = False
    Do While lExit = False
        With Selection.Find
             .Text = "Caption ?:"
             .Forward = True
             .Wrap = wdFindContinue
             .Format = True
             .MatchCase = False
             .MatchWholeWord = False
             .MatchWildcards = True
             .MatchSoundsLike = False
             .MatchAllWordForms = False
         End With
         If Selection.Find.Execute = True Then
             Selection.EndKey Unit:=wdLine, Extend:=wdExtend
             cReadstring = ""
             cReadstring = Trim(Mid(ActiveDocument.ActiveWindow.Selection.Text, 1, Len(ActiveDocument.ActiveWindow.Selection.Text) - 1))
             Selection.Find.Replacement.Text = "Picture " + Mid(cReadstring, 8, Len(cReadstring) - 8)
             Selection.Find.Execute Replace:=wdReplaceOne
          Else
            lExit = True
         End If
    Loop

End Sub

Sub EVWOpenImagesPicAndCaptxt()
'
' Macro opgenomen op 27-08-2014 door Daniel van de Stam
'Het gaat weleens fout bij het weghalen van de picture and caption texts. 
'Dan kun je deze gebruiken en bijvoorbeeld handmatig zoeken vervangen.
    
    Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    lExit = False
    Do While lExit = False
        With Selection.Find
             .Text = "https://"
             .Forward = True
             .Wrap = wdFindContinue
             .Format = True
             .MatchCase = False
             .MatchWholeWord = False
             .MatchWildcards = False
             .MatchSoundsLike = False
             .MatchAllWordForms = False
         End With
         If Selection.Find.Execute = True Then
             Selection.EndKey Unit:=wdLine, Extend:=wdExtend
             cReadstring = ""
             cReadstring = Trim(Mid(ActiveDocument.ActiveWindow.Selection.Text, 1, Len(ActiveDocument.ActiveWindow.Selection.Text) - 1))
             cReadDoc = ""
             cReadDoc = LCase(Mid(cReadstring, Len(cReadstring) - 2, 3))
             If cReadDoc = "bmp" Or cReadDoc = "jpg" Then
                 Selection.InlineShapes.AddPicture FileName:=cReadstring, LinkToFile:=False, SaveWithDocument:=True
             Else
                 Selection.Find.Replacement.Text = "http:\\"
                 Selection.Find.Execute Replace:=wdReplaceOne
             End If
         Else
            lExit = True
         End If
    Loop

End Sub

Sub EVWFileOpenOffice2003()
'
' FileTest Macro
' Macro opgenomen op 20-1-2005 door Jaap Bakker
'
    
    Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    lExit = False
    Do While lExit = False
        With Selection.Find
             .Text = "file:\\"
             .Forward = True
             .Wrap = wdFindContinue
             .Format = True
             .MatchCase = False
             .MatchWholeWord = False
             .MatchWildcards = False
             .MatchSoundsLike = False
             .MatchAllWordForms = False
         End With
         If Selection.Find.Execute = True Then
             Selection.EndKey Unit:=wdLine, Extend:=wdExtend
             cReadstring = ""
             cReadstring = Trim(Mid(ActiveDocument.ActiveWindow.Selection.Text, 8, Len(ActiveDocument.ActiveWindow.Selection.Text) - 8))
             cReadDoc = ""
             cReadDoc = Mid(cReadstring, Len(cReadstring) - 2, 3)
             If cReadDoc = "doc" Or cReadDoc = "dot" Then
                Documents.Open FileName:=cReadstring
                Selection.WholeStory
                Selection.Copy
                ActiveWindow.Close
                Selection.PasteAndFormat (wdPasteDefault)
             Else
                 Selection.Find.Replacement.Text = "file://"
                 Selection.Find.Execute Replace:=wdReplaceOne
             End If
         Else
            lExit = True
         End If
    Loop

  '  Selection.Find.ClearFormatting
  '  Selection.Find.Replacement.ClearFormatting
  '  With Selection.Find
  '      .Text = "http://"
  '      .Forward = True
  '      .Wrap = wdFindContinue
  '      .Format = True
  '      .MatchCase = False
  '      .MatchWholeWord = False
  '      .MatchWildcards = False
  '      .MatchSoundsLike = False
  '      .MatchAllWordForms = False
  '  End With
  '  If Selection.Find.Execute = True Then
  '      Selection.EndKey Unit:=wdLine, Extend:=wdExtend
  '      cReadstring = ""
  '      cReadstring = Mid(ActiveDocument.ActiveWindow.Selection.Text, 1, Len(ActiveDocument.ActiveWindow.Selection.Text) - 2)
''        Documents.Open FileName:=cReadstring
  '       ActiveDocument.Shapes.AddPicture (cReadstring)
  '  End If


End Sub

Sub EVWFileOpenOffice2000()
'
' FileTest Macro
' Macro opgenomen op 20-1-2005 door Jaap Bakker
'
    
    Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    lExit = False
    Do While lExit = False
        With Selection.Find
             .Text = "file:\\"
             .Forward = True
             .Wrap = wdFindContinue
             .Format = True
             .MatchCase = False
             .MatchWholeWord = False
             .MatchWildcards = False
             .MatchSoundsLike = False
             .MatchAllWordForms = False
         End With
         If Selection.Find.Execute = True Then
             Selection.EndKey Unit:=wdLine, Extend:=wdExtend
             cReadstring = ""
             cReadstring = Trim(Mid(ActiveDocument.ActiveWindow.Selection.Text, 8, Len(ActiveDocument.ActiveWindow.Selection.Text) - 8))
             cReadDoc = ""
             cReadDoc = Mid(cReadstring, Len(cReadstring) - 2, 3)
             If cReadDoc = "doc" Or cReadDoc = "dot" Then
                Documents.Open FileName:=cReadstring
                Selection.WholeStory
                Selection.Copy
                ActiveWindow.Close
                Selection.Paste
             Else
                Selection.Find.Replacement.Text = "file://"
                Selection.Find.Execute Replace:=wdReplaceOne
             End If
          Else
            lExit = True
         End If
    Loop

  '  Selection.Find.ClearFormatting
  '  Selection.Find.Replacement.ClearFormatting
  '  With Selection.Find
  '      .Text = "http://"
  '      .Forward = True
  '      .Wrap = wdFindContinue
  '      .Format = True
  '      .MatchCase = False
  '      .MatchWholeWord = False
  '      .MatchWildcards = False
  '      .MatchSoundsLike = False
  '      .MatchAllWordForms = False
  '  End With
  '  If Selection.Find.Execute = True Then
  '      Selection.EndKey Unit:=wdLine, Extend:=wdExtend
  '      cReadstring = ""
  '      cReadstring = Mid(ActiveDocument.ActiveWindow.Selection.Text, 1, Len(ActiveDocument.ActiveWindow.Selection.Text) - 2)
''        Documents.Open FileName:=cReadstring
  '       ActiveDocument.Shapes.AddPicture (cReadstring)
  '  End If


End Sub