Sub EveAbstrBook() ' ' EveAbstrBook Macro ' Macro opgenomen op 4-2-2002 door Jaap Bakker ' Dim actief, fs, envstring, cTempDir, findtext, cString Set fs = CreateObject("Scripting.FileSystemObject") envstring = Environ("TMP") If envstring = "" Then envstring = Environ("TEMP") End If If fs.fileexists(envstring + "\WORD.rtf") Then cTempDir = envstring Else If fs.fileexists("C:\TEMP\WORD.rtf") Then cTempDir = "C:\TEMP" Else If fs.fileexists("D:\TEMP\WORD.rtf") Then cTempDir = "D:\TEMP" Else If fs.fileexists("F:\TEMP\WORD.rtf") Then cTempDir = "F:\TEMP" Else If fs.fileexists("H:\TEMP\Word.rtf") Then cTempDir = "H:\TEMP" Else If fs.fileexists("K:\TEMP\Word.rtf") Then cTempDir = "K:\TEMP" Else If fs.fileexists("L:\TEMP\Word.rtf") Then cTempDir = "L:\TEMP" else If fs.fileexists("P:\TEMP\Word.rtf") Then cTempDir = "P:\TEMP" Else If fs.fileexists("U:\TEMP\Word.rtf") Then cTempDir = "U:\TEMP" Else If fs.fileexists("N:\TEMP\Word.rtf") Then cTempDir = "N:\TEMP" End If End If End If End If End If End If End If End If End If End If Documents.Open FileName:=cTempDir + "\WORD.rtf", ConfirmConversions:=False, ReadOnly:= _ False, AddToRecentFiles:=False, PasswordDocument:="", PasswordTemplate:= _ "", Revert:=False, WritePasswordDocument:="", WritePasswordTemplate:="", _ Format:=wdOpenFormatAuto, Encoding:=65001 ActiveDocument.SaveAs FileName:=cTempDir + "\WORD.rtf", FileFormat:=wdFormatRTF, _ LockComments:=False, Password:="", AddToRecentFiles:=True, WritePassword _ :="", ReadOnlyRecommended:=False, EmbedTrueTypeFonts:=False, _ SaveNativePictureFormat:=False, SaveFormsData:=False, SaveAsAOCELetter:= _ False ActiveDocument.Close actief = ActiveDocument ActiveDocument.MailMerge.MainDocumentType = wdFormLetters ActiveDocument.MailMerge.OpenDataSource Name:=cTempDir + "\WORD.RTF", ConfirmConversions:=True, ReadOnly:=False, LinkToSource:=True, _ AddToRecentFiles:=False, PasswordDocument:="", PasswordTemplate:="", _ WritePasswordDocument:="", WritePasswordTemplate:="", Revert:=False, _ Format:=wdOpenFormatAuto, Connection:="", SQLStatement:="", SQLStatement1 _ :="" With ActiveDocument.MailMerge .Destination = wdSendToNewDocument .MailAsAttachment = False .MailAddressFieldName = "" .MailSubject = "" .SuppressBlankLines = True With .DataSource .FirstRecord = wdDefaultFirstRecord .LastRecord = wdDefaultLastRecord End With .Execute Pause:=False End With Selection.Find.ClearFormatting Selection.Find.Replacement.ClearFormatting With Selection.Find .Text = "[Hrt]" .Replacement.Text = " ^l" .Forward = True .Wrap = wdFindContinue .Format = False .MatchCase = False .MatchWholeWord = False .MatchWildcards = False .MatchSoundsLike = False .MatchAllWordForms = False End With Selection.Find.Execute Replace:=wdReplaceAll Selection.Find.ClearFormatting Selection.Find.Replacement.ClearFormatting With Selection.Find .Text = "^b" .Replacement.Text = "^l^l" .Forward = True .Wrap = wdFindContinue .Format = False .MatchCase = False .MatchWholeWord = False .MatchWildcards = False .MatchSoundsLike = False .MatchAllWordForms = False End With Selection.Find.Execute Replace:=wdReplaceAll Selection.Find.ClearFormatting Selection.Find.Replacement.ClearFormatting With Selection.Find .Text = "[EveHPg]" .Replacement.Text = " ^m" .Forward = True .Wrap = wdFindContinue .Format = False .MatchCase = False .MatchWholeWord = False .MatchWildcards = False .MatchSoundsLike = False .MatchAllWordForms = False End With Selection.Find.Execute Replace:=wdReplaceAll Selection.Find.ClearFormatting Selection.Find.Replacement.ClearFormatting With Selection.Find .Text = "[EveC1]" .Replacement.Font.Superscript = True .Replacement.Text = "1" .Forward = True .Wrap = wdFindContinue .Format = True .MatchCase = False .MatchWholeWord = False .MatchWildcards = False .MatchSoundsLike = False .MatchAllWordForms = False End With Selection.Find.Execute Replace:=wdReplaceAll With Selection.Find .Text = "[EveC2]" .Replacement.Font.Superscript = True .Replacement.Text = "2" .Forward = True .Wrap = wdFindContinue .Format = True .MatchCase = False .MatchWholeWord = False .MatchWildcards = False .MatchSoundsLike = False .MatchAllWordForms = False End With Selection.Find.Execute Replace:=wdReplaceAll With Selection.Find .Text = "[EveC3]" .Replacement.Font.Superscript = True .Replacement.Text = "3" .Forward = True .Wrap = wdFindContinue .Format = True .MatchCase = False .MatchWholeWord = False .MatchWildcards = False .MatchSoundsLike = False .MatchAllWordForms = False End With Selection.Find.Execute Replace:=wdReplaceAll With Selection.Find .Text = "[EveC4]" .Replacement.Font.Superscript = True .Replacement.Text = "4" .Forward = True .Wrap = wdFindContinue .Format = True .MatchCase = False .MatchWholeWord = False .MatchWildcards = False .MatchSoundsLike = False .MatchAllWordForms = False End With Selection.Find.Execute Replace:=wdReplaceAll With Selection.Find .Text = "[EveC5]" .Replacement.Font.Superscript = True .Replacement.Text = "5" .Forward = True .Wrap = wdFindContinue .Format = True .MatchCase = False .MatchWholeWord = False .MatchWildcards = False .MatchSoundsLike = False .MatchAllWordForms = False End With Selection.Find.Execute Replace:=wdReplaceAll With Selection.Find .Text = "[EveC6]" .Replacement.Font.Superscript = True .Replacement.Text = "6" .Forward = True .Wrap = wdFindContinue .Format = True .MatchCase = False .MatchWholeWord = False .MatchWildcards = False .MatchSoundsLike = False .MatchAllWordForms = False End With Selection.Find.Execute Replace:=wdReplaceAll With Selection.Find .Text = "[EveC7]" .Replacement.Font.Superscript = True .Replacement.Text = "7" .Forward = True .Wrap = wdFindContinue .Format = True .MatchCase = False .MatchWholeWord = False .MatchWildcards = False .MatchSoundsLike = False .MatchAllWordForms = False End With Selection.Find.Execute Replace:=wdReplaceAll With Selection.Find .Text = "[EveC8]" .Replacement.Font.Superscript = True .Replacement.Text = "8" .Forward = True .Wrap = wdFindContinue .Format = True .MatchCase = False .MatchWholeWord = False .MatchWildcards = False .MatchSoundsLike = False .MatchAllWordForms = False End With Selection.Find.Execute Replace:=wdReplaceAll With Selection.Find .Text = "[EveC9]" .Replacement.Font.Superscript = True .Replacement.Text = "9" .Forward = True .Wrap = wdFindContinue .Format = True .MatchCase = False .MatchWholeWord = False .MatchWildcards = False .MatchSoundsLike = False .MatchAllWordForms = False End With Selection.Find.Execute Replace:=wdReplaceAll With Selection.Find .Text = "[EveC10]" .Replacement.Font.Superscript = True .Replacement.Text = "10" .Forward = True .Wrap = wdFindContinue .Format = True .MatchCase = False .MatchWholeWord = False .MatchWildcards = False .MatchSoundsLike = False .MatchAllWordForms = False End With Selection.Find.Execute Replace:=wdReplaceAll With Selection.Find .Text = "[EveC11]" .Replacement.Font.Superscript = True .Replacement.Text = "11" .Forward = True .Wrap = wdFindContinue .Format = True .MatchCase = False .MatchWholeWord = False .MatchWildcards = False .MatchSoundsLike = False .MatchAllWordForms = False End With Selection.Find.Execute Replace:=wdReplaceAll With Selection.Find .Text = "[EveC12]" .Replacement.Font.Superscript = True .Replacement.Text = "12" .Forward = True .Wrap = wdFindContinue .Format = True .MatchCase = False .MatchWholeWord = False .MatchWildcards = False .MatchSoundsLike = False .MatchAllWordForms = False End With Selection.Find.Execute Replace:=wdReplaceAll With Selection.Find .Text = "[EveC13]" .Replacement.Font.Superscript = True .Replacement.Text = "13" .Forward = True .Wrap = wdFindContinue .Format = True .MatchCase = False .MatchWholeWord = False .MatchWildcards = False .MatchSoundsLike = False .MatchAllWordForms = False End With Selection.Find.Execute Replace:=wdReplaceAll With Selection.Find .Text = "[EveC14]" .Replacement.Font.Superscript = True .Replacement.Text = "14" .Forward = True .Wrap = wdFindContinue .Format = True .MatchCase = False .MatchWholeWord = False .MatchWildcards = False .MatchSoundsLike = False .MatchAllWordForms = False End With Selection.Find.Execute Replace:=wdReplaceAll With Selection.Find .Text = "[EveC15]" .Replacement.Font.Superscript = True .Replacement.Text = "15" .Forward = True .Wrap = wdFindContinue .Format = True .MatchCase = False .MatchWholeWord = False .MatchWildcards = False .MatchSoundsLike = False .MatchAllWordForms = False End With Selection.Find.Execute Replace:=wdReplaceAll With Selection.Find .Text = "[EveC16]" .Replacement.Font.Superscript = True .Replacement.Text = "16" .Forward = True .Wrap = wdFindContinue .Format = True .MatchCase = False .MatchWholeWord = False .MatchWildcards = False .MatchSoundsLike = False .MatchAllWordForms = False End With Selection.Find.Execute Replace:=wdReplaceAll With Selection.Find .Text = "[EveC17]" .Replacement.Font.Superscript = True .Replacement.Text = "17" .Forward = True .Wrap = wdFindContinue .Format = True .MatchCase = False .MatchWholeWord = False .MatchWildcards = False .MatchSoundsLike = False .MatchAllWordForms = False End With Selection.Find.Execute Replace:=wdReplaceAll With Selection.Find .Text = "[EveC18]" .Replacement.Font.Superscript = True .Replacement.Text = "18" .Forward = True .Wrap = wdFindContinue .Format = True .MatchCase = False .MatchWholeWord = False .MatchWildcards = False .MatchSoundsLike = False .MatchAllWordForms = False End With Selection.Find.Execute Replace:=wdReplaceAll With Selection.Find .Text = "[EveC19]" .Replacement.Font.Superscript = True .Replacement.Text = "19" .Forward = True .Wrap = wdFindContinue .Format = True .MatchCase = False .MatchWholeWord = False .MatchWildcards = False .MatchSoundsLike = False .MatchAllWordForms = False End With Selection.Find.Execute Replace:=wdReplaceAll With Selection.Find .Text = "[EveC20]" .Replacement.Font.Superscript = True .Replacement.Text = "20" .Forward = True .Wrap = wdFindContinue .Format = True .MatchCase = False .MatchWholeWord = False .MatchWildcards = False .MatchSoundsLike = False .MatchAllWordForms = False End With Selection.Find.Execute Replace:=wdReplaceAll With Selection.Find .Text = "[EveC21]" .Replacement.Font.Superscript = True .Replacement.Text = "21" .Forward = True .Wrap = wdFindContinue .Format = True .MatchCase = False .MatchWholeWord = False .MatchWildcards = False .MatchSoundsLike = False .MatchAllWordForms = False End With Selection.Find.Execute Replace:=wdReplaceAll With Selection.Find .Text = "[EveC22]" .Replacement.Font.Superscript = True .Replacement.Text = "22" .Forward = True .Wrap = wdFindContinue .Format = True .MatchCase = False .MatchWholeWord = False .MatchWildcards = False .MatchSoundsLike = False .MatchAllWordForms = False End With Selection.Find.Execute Replace:=wdReplaceAll With Selection.Find .Text = "[EveC23]" .Replacement.Font.Superscript = True .Replacement.Text = "23" .Forward = True .Wrap = wdFindContinue .Format = True .MatchCase = False .MatchWholeWord = False .MatchWildcards = False .MatchSoundsLike = False .MatchAllWordForms = False End With Selection.Find.Execute Replace:=wdReplaceAll With Selection.Find .Text = "[EveC24]" .Replacement.Font.Superscript = True .Replacement.Text = "24" .Forward = True .Wrap = wdFindContinue .Format = True .MatchCase = False .MatchWholeWord = False .MatchWildcards = False .MatchSoundsLike = False .MatchAllWordForms = False End With Selection.Find.Execute Replace:=wdReplaceAll With Selection.Find .Text = "[EveC25]" .Replacement.Font.Superscript = True .Replacement.Text = "25" .Forward = True .Wrap = wdFindContinue .Format = True .MatchCase = False .MatchWholeWord = False .MatchWildcards = False .MatchSoundsLike = False .MatchAllWordForms = False End With Selection.Find.Execute Replace:=wdReplaceAll With Selection.Find .Text = "[EveC26]" .Replacement.Font.Superscript = True .Replacement.Text = "26" .Forward = True .Wrap = wdFindContinue .Format = True .MatchCase = False .MatchWholeWord = False .MatchWildcards = False .MatchSoundsLike = False .MatchAllWordForms = False End With Selection.Find.Execute Replace:=wdReplaceAll With Selection.Find .Text = "[EveC27]" .Replacement.Font.Superscript = True .Replacement.Text = "27" .Forward = True .Wrap = wdFindContinue .Format = True .MatchCase = False .MatchWholeWord = False .MatchWildcards = False .MatchSoundsLike = False .MatchAllWordForms = False End With Selection.Find.Execute Replace:=wdReplaceAll With Selection.Find .Text = "[EveC28]" .Replacement.Font.Superscript = True .Replacement.Text = "28" .Forward = True .Wrap = wdFindContinue .Format = True .MatchCase = False .MatchWholeWord = False .MatchWildcards = False .MatchSoundsLike = False .MatchAllWordForms = False End With Selection.Find.Execute Replace:=wdReplaceAll With Selection.Find .Text = "[EveC29]" .Replacement.Font.Superscript = True .Replacement.Text = "29" .Forward = True .Wrap = wdFindContinue .Format = True .MatchCase = False .MatchWholeWord = False .MatchWildcards = False .MatchSoundsLike = False .MatchAllWordForms = False End With Selection.Find.Execute Replace:=wdReplaceAll With Selection.Find .Text = "[EveC30]" .Replacement.Font.Superscript = True .Replacement.Text = "30" .Forward = True .Wrap = wdFindContinue .Format = True .MatchCase = False .MatchWholeWord = False .MatchWildcards = False .MatchSoundsLike = False .MatchAllWordForms = False End With Selection.Find.Execute Replace:=wdReplaceAll With Selection.Find .Text = ">™" .Replacement.Font.Superscript = False .Replacement.Text = ">" .Forward = True .Wrap = wdFindContinue .Format = True .MatchCase = False .MatchWholeWord = False .MatchWildcards = False .MatchSoundsLike = False .MatchAllWordForms = False End With Selection.Find.Execute Replace:=wdReplaceAll With Selection.Find .Text = "<" .Replacement.Font.Superscript = False .Replacement.Text = "<" .Forward = True .Wrap = wdFindContinue .Format = True .MatchCase = False .MatchWholeWord = False .MatchWildcards = False .MatchSoundsLike = False .MatchAllWordForms = False End With Selection.Find.Execute Replace:=wdReplaceAll With Selection.Find .Text = ">" .Replacement.Font.Superscript = False .Replacement.Text = ">" .Forward = True .Wrap = wdFindContinue .Format = True .MatchCase = False .MatchWholeWord = False .MatchWildcards = False .MatchSoundsLike = False .MatchAllWordForms = False End With Selection.Find.Execute Replace:=wdReplaceAll With Selection.Find .Text = "[simplequote]" .Replacement.Font.Superscript = False .Replacement.Text = "'" .Forward = True .Wrap = wdFindContinue .Format = True .MatchCase = False .MatchWholeWord = False .MatchWildcards = False .MatchSoundsLike = False .MatchAllWordForms = False End With Selection.Find.Execute Replace:=wdReplaceAll With Selection.Find .Text = "[quotleft]" .Replacement.Font.Superscript = False .Replacement.Text = "“" .Forward = True .Wrap = wdFindContinue .Format = True .MatchCase = False .MatchWholeWord = False .MatchWildcards = False .MatchSoundsLike = False .MatchAllWordForms = False End With Selection.Find.Execute Replace:=wdReplaceAll With Selection.Find .Text = "[quotright]" .Replacement.Font.Superscript = False .Replacement.Text = "”" .Forward = True .Wrap = wdFindContinue .Format = True .MatchCase = False .MatchWholeWord = False .MatchWildcards = False .MatchSoundsLike = False .MatchAllWordForms = False End With Selection.Find.Execute Replace:=wdReplaceAll With Selection.Find .Text = "[quotrightB]" .Replacement.Font.Superscript = False .Replacement.Text = "”" .Forward = True .Wrap = wdFindContinue .Format = True .MatchCase = False .MatchWholeWord = False .MatchWildcards = False .MatchSoundsLike = False .MatchAllWordForms = False End With Selection.Find.Execute Replace:=wdReplaceAll With Selection.Find .Text = "[quotrightB?]" .Replacement.Font.Superscript = False .Replacement.Text = "”" .Forward = True .Wrap = wdFindContinue .Format = True .MatchCase = False .MatchWholeWord = False .MatchWildcards = False .MatchSoundsLike = False .MatchAllWordForms = False End With Selection.Find.Execute Replace:=wdReplaceAll With Selection.Find .Text = "â€'" .Replacement.Font.Superscript = False .Replacement.Text = "-" .Forward = True .Wrap = wdFindContinue .Format = True .MatchCase = False .MatchWholeWord = False .MatchWildcards = False .MatchSoundsLike = False .MatchAllWordForms = False End With Selection.Find.Execute Replace:=wdReplaceAll With Selection.Find .Text = "‘" .Replacement.Font.Superscript = False .Replacement.Text = "'" .Forward = True .Wrap = wdFindContinue .Format = True .MatchCase = False .MatchWholeWord = False .MatchWildcards = False .MatchSoundsLike = False .MatchAllWordForms = False End With Selection.Find.Execute Replace:=wdReplaceAll With Selection.Find .Text = "’" .Replacement.Font.Superscript = False .Replacement.Text = "'" .Forward = True .Wrap = wdFindContinue .Format = True .MatchCase = False .MatchWholeWord = False .MatchWildcards = False .MatchSoundsLike = False .MatchAllWordForms = False End With Selection.Find.Execute Replace:=wdReplaceAll With Selection.Find .Text = "…" .Replacement.Font.Superscript = False .Replacement.Text = "…" .Forward = True .Wrap = wdFindContinue .Format = True .MatchCase = False .MatchWholeWord = False .MatchWildcards = False .MatchSoundsLike = False .MatchAllWordForms = False End With Selection.Find.Execute Replace:=wdReplaceAll With Selection.Find .Text = "“" .Replacement.Font.Superscript = False .Replacement.Text = "“" .Forward = True .Wrap = wdFindContinue .Format = True .MatchCase = False .MatchWholeWord = False .MatchWildcards = False .MatchSoundsLike = False .MatchAllWordForms = False End With Selection.Find.Execute Replace:=wdReplaceAll With Selection.Find .Text = "[RSYMBOL]" .Replacement.Font.Superscript = False .Replacement.Text = ChrW(9415) .Forward = True .Wrap = wdFindContinue .Format = True .MatchCase = False .MatchWholeWord = False .MatchWildcards = False .MatchSoundsLike = False .MatchAllWordForms = False End With Selection.Find.Execute Replace:=wdReplaceAll With Selection.Find .Text = "[CSYMBOL]" .Replacement.Font.Superscript = False .Replacement.Text = ChrW(9400) .Forward = True .Wrap = wdFindContinue .Format = True .MatchCase = False .MatchWholeWord = False .MatchWildcards = False .MatchSoundsLike = False .MatchAllWordForms = False End With Selection.Find.Execute Replace:=wdReplaceAll With Selection.Find .Text = "[3DOTS]" .Replacement.Font.Superscript = False .Replacement.Text = "…" .Forward = True .Wrap = wdFindContinue .Format = True .MatchCase = False .MatchWholeWord = False .MatchWildcards = False .MatchSoundsLike = False .MatchAllWordForms = False End With Selection.Find.Execute Replace:=wdReplaceAll With Selection.Find .Text = "[GREEKX]" .Replacement.Font.Superscript = False .Replacement.Text = "×" .Forward = True .Wrap = wdFindContinue .Format = True .MatchCase = False .MatchWholeWord = False .MatchWildcards = False .MatchSoundsLike = False .MatchAllWordForms = False End With Selection.Find.Execute Replace:=wdReplaceAll With Selection.Find .Text = "[ARROWRIGHT]" .Replacement.Font.Superscript = False .Replacement.Text = ChrW(8594) .Forward = True .Wrap = wdFindContinue .Format = True .MatchCase = False .MatchWholeWord = False .MatchWildcards = False .MatchSoundsLike = False .MatchAllWordForms = False End With Selection.Find.Execute Replace:=wdReplaceAll With Selection.Find .Text = "&Amp;" .Replacement.Font.Superscript = False .Replacement.Text = "&" .Forward = True .Wrap = wdFindContinue .Format = True .MatchCase = False .MatchWholeWord = False .MatchWildcards = False .MatchSoundsLike = False .MatchAllWordForms = False End With Selection.Find.Execute Replace:=wdReplaceAll For i = 1 To 10 With Selection.Find .Text = " " .Replacement.Font.Superscript = False .Replacement.Text = " " .Forward = True .Wrap = wdFindContinue .Format = True .MatchCase = False .MatchWholeWord = False .MatchWildcards = False .MatchSoundsLike = False .MatchAllWordForms = False End With Selection.Find.Execute Replace:=wdReplaceAll Next i With Selection.Find .Text = ", ," .Replacement.Font.Superscript = False .Replacement.Text = "," .Forward = True .Wrap = wdFindContinue .Format = True .MatchCase = False .MatchWholeWord = False .MatchWildcards = False .MatchSoundsLike = False .MatchAllWordForms = False End With Selection.Find.Execute Replace:=wdReplaceAll lExit = False Do While lExit = False With Selection.Find .Text = "�???;" .Replacement.Font.Superscript = False .Forward = True .Wrap = wdFindContinue .Format = True .MatchCase = False .MatchWholeWord = False .MatchWildcards = True .MatchSoundsLike = False .MatchAllWordForms = False End With If Selection.Find.Execute = True Then cReadstring = "" cReadstring = ActiveDocument.ActiveWindow.Selection.Text Selection.Find.Replacement.Text = ChrW(Val(Mid(cReadstring, 4, 3))) Selection.Find.Execute Replace:=wdReplaceOne Else Exit Do End If Loop lExit = False Do While lExit = False With Selection.Find .Text = "&#???;" .Replacement.Font.Superscript = False .Forward = True .Wrap = wdFindContinue .Format = True .MatchCase = False .MatchWholeWord = False .MatchWildcards = True .MatchSoundsLike = False .MatchAllWordForms = False End With If Selection.Find.Execute = True Then cReadstring = "" cReadstring = ActiveDocument.ActiveWindow.Selection.Text Selection.Find.Replacement.Text = ChrW(Val(Mid(cReadstring, 3, 3))) Selection.Find.Execute Replace:=wdReplaceOne Else Exit Do End If Loop lExit = False Do While lExit = False With Selection.Find .Text = "&#????;" .Replacement.Font.Superscript = False .Forward = True .Wrap = wdFindContinue .Format = True .MatchCase = False .MatchWholeWord = False .MatchWildcards = True .MatchSoundsLike = False .MatchAllWordForms = False End With If Selection.Find.Execute = True Then cReadstring = "" cReadstring = ActiveDocument.ActiveWindow.Selection.Text Selection.Find.Replacement.Text = ChrW(Val(Mid(cReadstring, 3, 4))) Selection.Find.Execute Replace:=wdReplaceOne Else Exit Do End If Loop lExit = False Do While lExit = False With Selection.Find .Text = "" .Replacement.Font.Superscript = False .Forward = True .Wrap = wdFindContinue .Format = True .MatchCase = False .MatchWholeWord = False .MatchWildcards = True .MatchSoundsLike = False .MatchAllWordForms = False End With If Selection.Find.Execute = True Then cReadstring = "" cReadstring = ActiveDocument.ActiveWindow.Selection.Text Selection.Find.Replacement.Text = ChrW(8805) Selection.Find.Execute Replace:=wdReplaceOne Else Exit Do End If Loop lExit = False Do While lExit = False With Selection.Find .Text = "" .Replacement.Font.Superscript = False .Forward = True .Wrap = wdFindContinue .Format = True .MatchCase = False .MatchWholeWord = False .MatchWildcards = True .MatchSoundsLike = False .MatchAllWordForms = False End With If Selection.Find.Execute = True Then cReadstring = "" cReadstring = ActiveDocument.ActiveWindow.Selection.Text Selection.Find.Replacement.Text = ChrW(8805) Selection.Find.Execute Replace:=wdReplaceOne Else Exit Do End If Loop lExit = False Do While lExit = False With Selection.Find .Text = "" .Replacement.Font.Superscript = False .Forward = True .Wrap = wdFindContinue .Format = True .MatchCase = False .MatchWholeWord = False .MatchWildcards = True .MatchSoundsLike = False .MatchAllWordForms = False End With If Selection.Find.Execute = True Then cReadstring = "" cReadstring = ActiveDocument.ActiveWindow.Selection.Text Selection.Find.Replacement.Text = "-" Selection.Find.Execute Replace:=wdReplaceOne Else Exit Do End If Loop lExit = False Do While lExit = False With Selection.Find .Text = "&#?????;" .Replacement.Font.Superscript = False .Forward = True .Wrap = wdFindContinue .Format = True .MatchCase = False .MatchWholeWord = False .MatchWildcards = True .MatchSoundsLike = False .MatchAllWordForms = False End With If Selection.Find.Execute = True Then cReadstring = "" cReadstring = ActiveDocument.ActiveWindow.Selection.Text Selection.Find.Replacement.Text = ChrW(Val(Mid(cReadstring, 3, 5))) Selection.Find.Execute Replace:=wdReplaceOne Else Exit Do End If Loop lExit = False Do While lExit = False With Selection.Find .Text = "&#??????;" .Replacement.Font.Superscript = False .Forward = True .Wrap = wdFindContinue .Format = True .MatchCase = False .MatchWholeWord = False .MatchWildcards = True .MatchSoundsLike = False .MatchAllWordForms = False End With If Selection.Find.Execute = True Then cReadstring = "" cReadstring = ActiveDocument.ActiveWindow.Selection.Text Selection.Find.Replacement.Text = ChrW(Val(Mid(cReadstring, 3, 6))) Selection.Find.Execute Replace:=wdReplaceOne Else Exit Do End If Loop For i = 1 To 25 lExit = False cString = "" For j = 1 To i cString = cString + "?" Next j Do While lExit = False With Selection.Find .Text = "??" + cString + "?/?" .Replacement.Font.Superscript = True .Replacement.Font.Subscript = False .Forward = True .Wrap = wdFindContinue .Format = True .MatchCase = False .MatchWholeWord = False .MatchWildcards = True .MatchSoundsLike = False .MatchAllWordForms = False End With If Selection.Find.Execute = True Then cReadstring = "" cReadstring = ActiveDocument.ActiveWindow.Selection.Text Selection.Find.Replacement.Text = Mid(cReadstring, 6, i) Selection.Find.Execute Replace:=wdReplaceOne Else Exit Do End If Loop Next i For i = 1 To 25 lExit = False cString = "" For j = 1 To i cString = cString + "?" Next j Do While lExit = False With Selection.Find .Text = "??" + cString + "?/?" .Replacement.Font.Superscript = False .Replacement.Font.Subscript = True .Forward = True .Wrap = wdFindContinue .Format = True .MatchCase = False .MatchWholeWord = False .MatchWildcards = True .MatchSoundsLike = False .MatchAllWordForms = False End With If Selection.Find.Execute = True Then cReadstring = "" cReadstring = ActiveDocument.ActiveWindow.Selection.Text Selection.Find.Replacement.Text = Mid(cReadstring, 6, i) Selection.Find.Execute Replace:=wdReplaceOne Else Exit Do End If Loop Next i For i = 1 To 25 lExit = False cString = "" For j = 1 To i cString = cString + "?" Next j Do While lExit = False With Selection.Find .Text = "??" + cString + "?/?" .Replacement.Font.Superscript = True .Replacement.Font.Subscript = False .Forward = True .Wrap = wdFindContinue .Format = True .MatchCase = False .MatchWholeWord = False .MatchWildcards = True .MatchSoundsLike = False .MatchAllWordForms = False End With If Selection.Find.Execute = True Then cReadstring = "" cReadstring = ActiveDocument.ActiveWindow.Selection.Text Selection.Find.Replacement.Text = Mid(cReadstring, 6, i) Selection.Find.Execute Replace:=wdReplaceOne Else Exit Do End If Loop Next i For i = 1 To 25 lExit = False cString = "" For j = 1 To i cString = cString + "?" Next j Do While lExit = False With Selection.Find .Text = "??" + cString + "?/?" .Replacement.Font.Superscript = False .Replacement.Font.Subscript = True .Forward = True .Wrap = wdFindContinue .Format = True .MatchCase = False .MatchWholeWord = False .MatchWildcards = True .MatchSoundsLike = False .MatchAllWordForms = False End With If Selection.Find.Execute = True Then cReadstring = "" cReadstring = ActiveDocument.ActiveWindow.Selection.Text Selection.Find.Replacement.Text = Mid(cReadstring, 6, i) Selection.Find.Execute Replace:=wdReplaceOne Else Exit Do End If Loop Next i For i = 1 To 150 lExit = False cString = "" For j = 1 To i cString = cString + "?" Next j Do While lExit = False With Selection.Find .Text = "??" + cString + "?/?" .Replacement.Font.Superscript = False .Replacement.Font.Subscript = False .Replacement.Font.Bold = True .Forward = True .Wrap = wdFindContinue .Format = True .MatchCase = False .MatchWholeWord = False .MatchWildcards = True .MatchSoundsLike = False .MatchAllWordForms = False End With If Selection.Find.Execute = True Then cReadstring = "" cReadstring = ActiveDocument.ActiveWindow.Selection.Text Selection.Find.Replacement.Text = Mid(cReadstring, 4, i) Selection.Find.Execute Replace:=wdReplaceOne Else Exit Do End If Loop Next i For i = 1 To 150 lExit = False cString = "" For j = 1 To i cString = cString + "?" Next j Do While lExit = False With Selection.Find .Text = "??" + cString + "?/?" .Replacement.Font.Superscript = False .Replacement.Font.Subscript = False .Replacement.Font.Bold = True .Forward = True .Wrap = wdFindContinue .Format = True .MatchCase = False .MatchWholeWord = False .MatchWildcards = True .MatchSoundsLike = False .MatchAllWordForms = False End With If Selection.Find.Execute = True Then cReadstring = "" cReadstring = ActiveDocument.ActiveWindow.Selection.Text Selection.Find.Replacement.Text = Mid(cReadstring, 4, i) Selection.Find.Execute Replace:=wdReplaceOne Else Exit Do End If Loop Next i For i = 1 To 150 lExit = False cString = "" For j = 1 To i cString = cString + "?" Next j Do While lExit = False With Selection.Find .Text = "??" + cString + "?/?" .Replacement.Font.Italic = True .Replacement.Font.Bold = False .Forward = True .Wrap = wdFindContinue .Format = True .MatchCase = False .MatchWholeWord = False .MatchWildcards = True .MatchSoundsLike = False .MatchAllWordForms = False End With If Selection.Find.Execute = True Then cReadstring = "" cReadstring = ActiveDocument.ActiveWindow.Selection.Text Selection.Find.Replacement.Text = Mid(cReadstring, 4, i) Selection.Find.Execute Replace:=wdReplaceOne Else Exit Do End If Loop Next i For i = 1 To 150 lExit = False cString = "" For j = 1 To i cString = cString + "?" Next j Do While lExit = False With Selection.Find .Text = "??" + cString + "?/?" .Replacement.Font.Italic = True .Replacement.Font.Bold = False .Forward = True .Wrap = wdFindContinue .Format = True .MatchCase = False .MatchWholeWord = False .MatchWildcards = True .MatchSoundsLike = False .MatchAllWordForms = False End With If Selection.Find.Execute = True Then cReadstring = "" cReadstring = ActiveDocument.ActiveWindow.Selection.Text Selection.Find.Replacement.Text = Mid(cReadstring, 4, i) Selection.Find.Execute Replace:=wdReplaceOne Else Exit Do End If Loop Next i For i = 1 To 150 lExit = False cString = "" For j = 1 To i cString = cString + "?" Next j Do While lExit = False With Selection.Find .Text = "??" + cString + "?/?" .Replacement.Font.Underline = True .Replacement.Font.Italic = False .Forward = True .Wrap = wdFindContinue .Format = True .MatchCase = False .MatchWholeWord = False .MatchWildcards = True .MatchSoundsLike = False .MatchAllWordForms = False End With If Selection.Find.Execute = True Then cReadstring = "" cReadstring = ActiveDocument.ActiveWindow.Selection.Text Selection.Find.Replacement.Text = Mid(cReadstring, 4, i) Selection.Find.Execute Replace:=wdReplaceOne Else Exit Do End If Loop Next i For i = 1 To 150 lExit = False cString = "" For j = 1 To i cString = cString + "?" Next j Do While lExit = False With Selection.Find .Text = "??" + cString + "?/?" .Replacement.Font.Underline = True .Replacement.Font.Italic = False .Forward = True .Wrap = wdFindContinue .Format = True .MatchCase = False .MatchWholeWord = False .MatchWildcards = True .MatchSoundsLike = False .MatchAllWordForms = False End With If Selection.Find.Execute = True Then cReadstring = "" cReadstring = ActiveDocument.ActiveWindow.Selection.Text Selection.Find.Replacement.Text = Mid(cReadstring, 4, i) Selection.Find.Execute Replace:=wdReplaceOne Else Exit Do End If Loop Next i Documents(actief).Activate ActiveDocument.Saved = True ActiveDocument.Close End Sub Sub EveAbstrBookNoUTF() ' ' EveAbstrBook Macro ' Macro opgenomen op 4-2-2002 door Jaap Bakker ' Dim actief, fs, envstring, cTempDir, findtext, cString Set fs = CreateObject("Scripting.FileSystemObject") envstring = Environ("TMP") If envstring = "" Then envstring = Environ("TEMP") End If If fs.fileexists(envstring + "\WORD.rtf") Then cTempDir = envstring Else If fs.fileexists("C:\TEMP\WORD.rtf") Then cTempDir = "C:\TEMP" Else If fs.fileexists("D:\TEMP\WORD.rtf") Then cTempDir = "D:\TEMP" Else If fs.fileexists("F:\TEMP\WORD.rtf") Then cTempDir = "F:\TEMP" Else If fs.fileexists("H:\TEMP\Word.rtf") Then cTempDir = "H:\TEMP" Else If fs.fileexists("K:\TEMP\Word.rtf") Then cTempDir = "K:\TEMP" Else If fs.fileexists("L:\TEMP\Word.rtf") Then cTempDir = "L:\TEMP" Else If fs.fileexists("P:\TEMP\Word.rtf") Then cTempDir = "P:\TEMP" Else If fs.fileexists("U:\TEMP\Word.rtf") Then cTempDir = "U:\TEMP" Else If fs.fileexists("N:\TEMP\Word.rtf") Then cTempDir = "N:\TEMP" End If End If End If End If End If End If End If End If End If End If actief = ActiveDocument ActiveDocument.MailMerge.MainDocumentType = wdFormLetters ActiveDocument.MailMerge.OpenDataSource Name:=cTempDir + "\WORD.RTF", ConfirmConversions:=True, ReadOnly:=False, LinkToSource:=True, _ AddToRecentFiles:=False, PasswordDocument:="", PasswordTemplate:="", _ WritePasswordDocument:="", WritePasswordTemplate:="", Revert:=False, _ Format:=wdOpenFormatAuto, Connection:="", SQLStatement:="", SQLStatement1 _ :="" With ActiveDocument.MailMerge .Destination = wdSendToNewDocument .MailAsAttachment = False .MailAddressFieldName = "" .MailSubject = "" .SuppressBlankLines = True With .DataSource .FirstRecord = wdDefaultFirstRecord .LastRecord = wdDefaultLastRecord End With .Execute Pause:=False End With Selection.Find.ClearFormatting Selection.Find.Replacement.ClearFormatting With Selection.Find .Text = "[Hrt]" .Replacement.Text = " ^l" .Forward = True .Wrap = wdFindContinue .Format = False .MatchCase = False .MatchWholeWord = False .MatchWildcards = False .MatchSoundsLike = False .MatchAllWordForms = False End With Selection.Find.Execute Replace:=wdReplaceAll Selection.Find.ClearFormatting Selection.Find.Replacement.ClearFormatting With Selection.Find .Text = "^b" .Replacement.Text = "^l^l" .Forward = True .Wrap = wdFindContinue .Format = False .MatchCase = False .MatchWholeWord = False .MatchWildcards = False .MatchSoundsLike = False .MatchAllWordForms = False End With Selection.Find.Execute Replace:=wdReplaceAll Selection.Find.ClearFormatting Selection.Find.Replacement.ClearFormatting With Selection.Find .Text = "[EveHPg]" .Replacement.Text = " ^m" .Forward = True .Wrap = wdFindContinue .Format = False .MatchCase = False .MatchWholeWord = False .MatchWildcards = False .MatchSoundsLike = False .MatchAllWordForms = False End With Selection.Find.Execute Replace:=wdReplaceAll Selection.Find.ClearFormatting Selection.Find.Replacement.ClearFormatting With Selection.Find .Text = "[EveC1]" .Replacement.Font.Superscript = True .Replacement.Text = "1" .Forward = True .Wrap = wdFindContinue .Format = True .MatchCase = False .MatchWholeWord = False .MatchWildcards = False .MatchSoundsLike = False .MatchAllWordForms = False End With Selection.Find.Execute Replace:=wdReplaceAll With Selection.Find .Text = "[EveC2]" .Replacement.Font.Superscript = True .Replacement.Text = "2" .Forward = True .Wrap = wdFindContinue .Format = True .MatchCase = False .MatchWholeWord = False .MatchWildcards = False .MatchSoundsLike = False .MatchAllWordForms = False End With Selection.Find.Execute Replace:=wdReplaceAll With Selection.Find .Text = "[EveC3]" .Replacement.Font.Superscript = True .Replacement.Text = "3" .Forward = True .Wrap = wdFindContinue .Format = True .MatchCase = False .MatchWholeWord = False .MatchWildcards = False .MatchSoundsLike = False .MatchAllWordForms = False End With Selection.Find.Execute Replace:=wdReplaceAll With Selection.Find .Text = "[EveC4]" .Replacement.Font.Superscript = True .Replacement.Text = "4" .Forward = True .Wrap = wdFindContinue .Format = True .MatchCase = False .MatchWholeWord = False .MatchWildcards = False .MatchSoundsLike = False .MatchAllWordForms = False End With Selection.Find.Execute Replace:=wdReplaceAll With Selection.Find .Text = "[EveC5]" .Replacement.Font.Superscript = True .Replacement.Text = "5" .Forward = True .Wrap = wdFindContinue .Format = True .MatchCase = False .MatchWholeWord = False .MatchWildcards = False .MatchSoundsLike = False .MatchAllWordForms = False End With Selection.Find.Execute Replace:=wdReplaceAll With Selection.Find .Text = "[EveC6]" .Replacement.Font.Superscript = True .Replacement.Text = "6" .Forward = True .Wrap = wdFindContinue .Format = True .MatchCase = False .MatchWholeWord = False .MatchWildcards = False .MatchSoundsLike = False .MatchAllWordForms = False End With Selection.Find.Execute Replace:=wdReplaceAll With Selection.Find .Text = "[EveC7]" .Replacement.Font.Superscript = True .Replacement.Text = "7" .Forward = True .Wrap = wdFindContinue .Format = True .MatchCase = False .MatchWholeWord = False .MatchWildcards = False .MatchSoundsLike = False .MatchAllWordForms = False End With Selection.Find.Execute Replace:=wdReplaceAll With Selection.Find .Text = "[EveC8]" .Replacement.Font.Superscript = True .Replacement.Text = "8" .Forward = True .Wrap = wdFindContinue .Format = True .MatchCase = False .MatchWholeWord = False .MatchWildcards = False .MatchSoundsLike = False .MatchAllWordForms = False End With Selection.Find.Execute Replace:=wdReplaceAll With Selection.Find .Text = "[EveC9]" .Replacement.Font.Superscript = True .Replacement.Text = "9" .Forward = True .Wrap = wdFindContinue .Format = True .MatchCase = False .MatchWholeWord = False .MatchWildcards = False .MatchSoundsLike = False .MatchAllWordForms = False End With Selection.Find.Execute Replace:=wdReplaceAll With Selection.Find .Text = "[EveC10]" .Replacement.Font.Superscript = True .Replacement.Text = "10" .Forward = True .Wrap = wdFindContinue .Format = True .MatchCase = False .MatchWholeWord = False .MatchWildcards = False .MatchSoundsLike = False .MatchAllWordForms = False End With Selection.Find.Execute Replace:=wdReplaceAll With Selection.Find .Text = "[EveC11]" .Replacement.Font.Superscript = True .Replacement.Text = "11" .Forward = True .Wrap = wdFindContinue .Format = True .MatchCase = False .MatchWholeWord = False .MatchWildcards = False .MatchSoundsLike = False .MatchAllWordForms = False End With Selection.Find.Execute Replace:=wdReplaceAll With Selection.Find .Text = "[EveC12]" .Replacement.Font.Superscript = True .Replacement.Text = "12" .Forward = True .Wrap = wdFindContinue .Format = True .MatchCase = False .MatchWholeWord = False .MatchWildcards = False .MatchSoundsLike = False .MatchAllWordForms = False End With Selection.Find.Execute Replace:=wdReplaceAll With Selection.Find .Text = "[EveC13]" .Replacement.Font.Superscript = True .Replacement.Text = "13" .Forward = True .Wrap = wdFindContinue .Format = True .MatchCase = False .MatchWholeWord = False .MatchWildcards = False .MatchSoundsLike = False .MatchAllWordForms = False End With Selection.Find.Execute Replace:=wdReplaceAll With Selection.Find .Text = "[EveC14]" .Replacement.Font.Superscript = True .Replacement.Text = "14" .Forward = True .Wrap = wdFindContinue .Format = True .MatchCase = False .MatchWholeWord = False .MatchWildcards = False .MatchSoundsLike = False .MatchAllWordForms = False End With Selection.Find.Execute Replace:=wdReplaceAll With Selection.Find .Text = "[EveC15]" .Replacement.Font.Superscript = True .Replacement.Text = "15" .Forward = True .Wrap = wdFindContinue .Format = True .MatchCase = False .MatchWholeWord = False .MatchWildcards = False .MatchSoundsLike = False .MatchAllWordForms = False End With Selection.Find.Execute Replace:=wdReplaceAll With Selection.Find .Text = "[EveC16]" .Replacement.Font.Superscript = True .Replacement.Text = "16" .Forward = True .Wrap = wdFindContinue .Format = True .MatchCase = False .MatchWholeWord = False .MatchWildcards = False .MatchSoundsLike = False .MatchAllWordForms = False End With Selection.Find.Execute Replace:=wdReplaceAll With Selection.Find .Text = "[EveC17]" .Replacement.Font.Superscript = True .Replacement.Text = "17" .Forward = True .Wrap = wdFindContinue .Format = True .MatchCase = False .MatchWholeWord = False .MatchWildcards = False .MatchSoundsLike = False .MatchAllWordForms = False End With Selection.Find.Execute Replace:=wdReplaceAll With Selection.Find .Text = "[EveC18]" .Replacement.Font.Superscript = True .Replacement.Text = "18" .Forward = True .Wrap = wdFindContinue .Format = True .MatchCase = False .MatchWholeWord = False .MatchWildcards = False .MatchSoundsLike = False .MatchAllWordForms = False End With Selection.Find.Execute Replace:=wdReplaceAll With Selection.Find .Text = "[EveC19]" .Replacement.Font.Superscript = True .Replacement.Text = "19" .Forward = True .Wrap = wdFindContinue .Format = True .MatchCase = False .MatchWholeWord = False .MatchWildcards = False .MatchSoundsLike = False .MatchAllWordForms = False End With Selection.Find.Execute Replace:=wdReplaceAll With Selection.Find .Text = "[EveC20]" .Replacement.Font.Superscript = True .Replacement.Text = "20" .Forward = True .Wrap = wdFindContinue .Format = True .MatchCase = False .MatchWholeWord = False .MatchWildcards = False .MatchSoundsLike = False .MatchAllWordForms = False End With Selection.Find.Execute Replace:=wdReplaceAll With Selection.Find .Text = "[EveC21]" .Replacement.Font.Superscript = True .Replacement.Text = "21" .Forward = True .Wrap = wdFindContinue .Format = True .MatchCase = False .MatchWholeWord = False .MatchWildcards = False .MatchSoundsLike = False .MatchAllWordForms = False End With Selection.Find.Execute Replace:=wdReplaceAll With Selection.Find .Text = "[EveC22]" .Replacement.Font.Superscript = True .Replacement.Text = "22" .Forward = True .Wrap = wdFindContinue .Format = True .MatchCase = False .MatchWholeWord = False .MatchWildcards = False .MatchSoundsLike = False .MatchAllWordForms = False End With Selection.Find.Execute Replace:=wdReplaceAll With Selection.Find .Text = "[EveC23]" .Replacement.Font.Superscript = True .Replacement.Text = "23" .Forward = True .Wrap = wdFindContinue .Format = True .MatchCase = False .MatchWholeWord = False .MatchWildcards = False .MatchSoundsLike = False .MatchAllWordForms = False End With Selection.Find.Execute Replace:=wdReplaceAll With Selection.Find .Text = "[EveC24]" .Replacement.Font.Superscript = True .Replacement.Text = "24" .Forward = True .Wrap = wdFindContinue .Format = True .MatchCase = False .MatchWholeWord = False .MatchWildcards = False .MatchSoundsLike = False .MatchAllWordForms = False End With Selection.Find.Execute Replace:=wdReplaceAll With Selection.Find .Text = "[EveC25]" .Replacement.Font.Superscript = True .Replacement.Text = "25" .Forward = True .Wrap = wdFindContinue .Format = True .MatchCase = False .MatchWholeWord = False .MatchWildcards = False .MatchSoundsLike = False .MatchAllWordForms = False End With Selection.Find.Execute Replace:=wdReplaceAll With Selection.Find .Text = "[EveC26]" .Replacement.Font.Superscript = True .Replacement.Text = "26" .Forward = True .Wrap = wdFindContinue .Format = True .MatchCase = False .MatchWholeWord = False .MatchWildcards = False .MatchSoundsLike = False .MatchAllWordForms = False End With Selection.Find.Execute Replace:=wdReplaceAll With Selection.Find .Text = "[EveC27]" .Replacement.Font.Superscript = True .Replacement.Text = "27" .Forward = True .Wrap = wdFindContinue .Format = True .MatchCase = False .MatchWholeWord = False .MatchWildcards = False .MatchSoundsLike = False .MatchAllWordForms = False End With Selection.Find.Execute Replace:=wdReplaceAll With Selection.Find .Text = "[EveC28]" .Replacement.Font.Superscript = True .Replacement.Text = "28" .Forward = True .Wrap = wdFindContinue .Format = True .MatchCase = False .MatchWholeWord = False .MatchWildcards = False .MatchSoundsLike = False .MatchAllWordForms = False End With Selection.Find.Execute Replace:=wdReplaceAll With Selection.Find .Text = "[EveC29]" .Replacement.Font.Superscript = True .Replacement.Text = "29" .Forward = True .Wrap = wdFindContinue .Format = True .MatchCase = False .MatchWholeWord = False .MatchWildcards = False .MatchSoundsLike = False .MatchAllWordForms = False End With Selection.Find.Execute Replace:=wdReplaceAll With Selection.Find .Text = "[EveC30]" .Replacement.Font.Superscript = True .Replacement.Text = "30" .Forward = True .Wrap = wdFindContinue .Format = True .MatchCase = False .MatchWholeWord = False .MatchWildcards = False .MatchSoundsLike = False .MatchAllWordForms = False End With Selection.Find.Execute Replace:=wdReplaceAll With Selection.Find .Text = ">™" .Replacement.Font.Superscript = False .Replacement.Text = ">" .Forward = True .Wrap = wdFindContinue .Format = True .MatchCase = False .MatchWholeWord = False .MatchWildcards = False .MatchSoundsLike = False .MatchAllWordForms = False End With Selection.Find.Execute Replace:=wdReplaceAll With Selection.Find .Text = "<" .Replacement.Font.Superscript = False .Replacement.Text = "<" .Forward = True .Wrap = wdFindContinue .Format = True .MatchCase = False .MatchWholeWord = False .MatchWildcards = False .MatchSoundsLike = False .MatchAllWordForms = False End With Selection.Find.Execute Replace:=wdReplaceAll With Selection.Find .Text = ">" .Replacement.Font.Superscript = False .Replacement.Text = ">" .Forward = True .Wrap = wdFindContinue .Format = True .MatchCase = False .MatchWholeWord = False .MatchWildcards = False .MatchSoundsLike = False .MatchAllWordForms = False End With Selection.Find.Execute Replace:=wdReplaceAll With Selection.Find .Text = "[simplequote]" .Replacement.Font.Superscript = False .Replacement.Text = "'" .Forward = True .Wrap = wdFindContinue .Format = True .MatchCase = False .MatchWholeWord = False .MatchWildcards = False .MatchSoundsLike = False .MatchAllWordForms = False End With Selection.Find.Execute Replace:=wdReplaceAll With Selection.Find .Text = "<™" .Replacement.Font.Superscript = False .Replacement.Text = "<" .Forward = True .Wrap = wdFindContinue .Format = True .MatchCase = False .MatchWholeWord = False .MatchWildcards = False .MatchSoundsLike = False .MatchAllWordForms = False End With Selection.Find.Execute Replace:=wdReplaceAll With Selection.Find .Text = "[quotleft]" .Replacement.Font.Superscript = False .Replacement.Text = "“" .Forward = True .Wrap = wdFindContinue .Format = True .MatchCase = False .MatchWholeWord = False .MatchWildcards = False .MatchSoundsLike = False .MatchAllWordForms = False End With Selection.Find.Execute Replace:=wdReplaceAll With Selection.Find .Text = "[quotright]" .Replacement.Font.Superscript = False .Replacement.Text = "”" .Forward = True .Wrap = wdFindContinue .Format = True .MatchCase = False .MatchWholeWord = False .MatchWildcards = False .MatchSoundsLike = False .MatchAllWordForms = False End With Selection.Find.Execute Replace:=wdReplaceAll With Selection.Find .Text = "[quotrightB]" .Replacement.Font.Superscript = False .Replacement.Text = "”" .Forward = True .Wrap = wdFindContinue .Format = True .MatchCase = False .MatchWholeWord = False .MatchWildcards = False .MatchSoundsLike = False .MatchAllWordForms = False End With Selection.Find.Execute Replace:=wdReplaceAll With Selection.Find .Text = "[quotrightB?]" .Replacement.Font.Superscript = False .Replacement.Text = "”" .Forward = True .Wrap = wdFindContinue .Format = True .MatchCase = False .MatchWholeWord = False .MatchWildcards = False .MatchSoundsLike = False .MatchAllWordForms = False End With Selection.Find.Execute Replace:=wdReplaceAll With Selection.Find .Text = "â€'" .Replacement.Font.Superscript = False .Replacement.Text = "-" .Forward = True .Wrap = wdFindContinue .Format = True .MatchCase = False .MatchWholeWord = False .MatchWildcards = False .MatchSoundsLike = False .MatchAllWordForms = False End With Selection.Find.Execute Replace:=wdReplaceAll With Selection.Find .Text = "‘" .Replacement.Font.Superscript = False .Replacement.Text = "'" .Forward = True .Wrap = wdFindContinue .Format = True .MatchCase = False .MatchWholeWord = False .MatchWildcards = False .MatchSoundsLike = False .MatchAllWordForms = False End With Selection.Find.Execute Replace:=wdReplaceAll With Selection.Find .Text = "’" .Replacement.Font.Superscript = False .Replacement.Text = "'" .Forward = True .Wrap = wdFindContinue .Format = True .MatchCase = False .MatchWholeWord = False .MatchWildcards = False .MatchSoundsLike = False .MatchAllWordForms = False End With Selection.Find.Execute Replace:=wdReplaceAll With Selection.Find .Text = "…" .Replacement.Font.Superscript = False .Replacement.Text = "…" .Forward = True .Wrap = wdFindContinue .Format = True .MatchCase = False .MatchWholeWord = False .MatchWildcards = False .MatchSoundsLike = False .MatchAllWordForms = False End With Selection.Find.Execute Replace:=wdReplaceAll With Selection.Find .Text = "“" .Replacement.Font.Superscript = False .Replacement.Text = "“" .Forward = True .Wrap = wdFindContinue .Format = True .MatchCase = False .MatchWholeWord = False .MatchWildcards = False .MatchSoundsLike = False .MatchAllWordForms = False End With Selection.Find.Execute Replace:=wdReplaceAll With Selection.Find .Text = "[RSYMBOL]" .Replacement.Font.Superscript = False .Replacement.Text = ChrW(9415) .Forward = True .Wrap = wdFindContinue .Format = True .MatchCase = False .MatchWholeWord = False .MatchWildcards = False .MatchSoundsLike = False .MatchAllWordForms = False End With Selection.Find.Execute Replace:=wdReplaceAll With Selection.Find .Text = "[CSYMBOL]" .Replacement.Font.Superscript = False .Replacement.Text = ChrW(9400) .Forward = True .Wrap = wdFindContinue .Format = True .MatchCase = False .MatchWholeWord = False .MatchWildcards = False .MatchSoundsLike = False .MatchAllWordForms = False End With Selection.Find.Execute Replace:=wdReplaceAll With Selection.Find .Text = "[3DOTS]" .Replacement.Font.Superscript = False .Replacement.Text = "…" .Forward = True .Wrap = wdFindContinue .Format = True .MatchCase = False .MatchWholeWord = False .MatchWildcards = False .MatchSoundsLike = False .MatchAllWordForms = False End With Selection.Find.Execute Replace:=wdReplaceAll With Selection.Find .Text = "[GREEKX]" .Replacement.Font.Superscript = False .Replacement.Text = "×" .Forward = True .Wrap = wdFindContinue .Format = True .MatchCase = False .MatchWholeWord = False .MatchWildcards = False .MatchSoundsLike = False .MatchAllWordForms = False End With Selection.Find.Execute Replace:=wdReplaceAll With Selection.Find .Text = "[ARROWRIGHT]" .Replacement.Font.Superscript = False .Replacement.Text = ChrW(8594) .Forward = True .Wrap = wdFindContinue .Format = True .MatchCase = False .MatchWholeWord = False .MatchWildcards = False .MatchSoundsLike = False .MatchAllWordForms = False End With Selection.Find.Execute Replace:=wdReplaceAll With Selection.Find .Text = "&Amp;" .Replacement.Font.Superscript = False .Replacement.Text = "&" .Forward = True .Wrap = wdFindContinue .Format = True .MatchCase = False .MatchWholeWord = False .MatchWildcards = False .MatchSoundsLike = False .MatchAllWordForms = False End With Selection.Find.Execute Replace:=wdReplaceAll For i = 1 To 10 With Selection.Find .Text = " " .Replacement.Font.Superscript = False .Replacement.Text = " " .Forward = True .Wrap = wdFindContinue .Format = True .MatchCase = False .MatchWholeWord = False .MatchWildcards = False .MatchSoundsLike = False .MatchAllWordForms = False End With Selection.Find.Execute Replace:=wdReplaceAll Next i With Selection.Find .Text = ", ," .Replacement.Font.Superscript = False .Replacement.Text = "," .Forward = True .Wrap = wdFindContinue .Format = True .MatchCase = False .MatchWholeWord = False .MatchWildcards = False .MatchSoundsLike = False .MatchAllWordForms = False End With Selection.Find.Execute Replace:=wdReplaceAll lExit = False Do While lExit = False With Selection.Find .Text = "�???;" .Replacement.Font.Superscript = False .Forward = True .Wrap = wdFindContinue .Format = True .MatchCase = False .MatchWholeWord = False .MatchWildcards = True .MatchSoundsLike = False .MatchAllWordForms = False End With If Selection.Find.Execute = True Then cReadstring = "" cReadstring = ActiveDocument.ActiveWindow.Selection.Text Selection.Find.Replacement.Text = ChrW(Val(Mid(cReadstring, 4, 3))) Selection.Find.Execute Replace:=wdReplaceOne Else Exit Do End If Loop lExit = False Do While lExit = False With Selection.Find .Text = "&#???;" .Replacement.Font.Superscript = False .Forward = True .Wrap = wdFindContinue .Format = True .MatchCase = False .MatchWholeWord = False .MatchWildcards = True .MatchSoundsLike = False .MatchAllWordForms = False End With If Selection.Find.Execute = True Then cReadstring = "" cReadstring = ActiveDocument.ActiveWindow.Selection.Text Selection.Find.Replacement.Text = ChrW(Val(Mid(cReadstring, 3, 3))) Selection.Find.Execute Replace:=wdReplaceOne Else Exit Do End If Loop lExit = False Do While lExit = False With Selection.Find .Text = "&#????;" .Replacement.Font.Superscript = False .Forward = True .Wrap = wdFindContinue .Format = True .MatchCase = False .MatchWholeWord = False .MatchWildcards = True .MatchSoundsLike = False .MatchAllWordForms = False End With If Selection.Find.Execute = True Then cReadstring = "" cReadstring = ActiveDocument.ActiveWindow.Selection.Text Selection.Find.Replacement.Text = ChrW(Val(Mid(cReadstring, 3, 4))) Selection.Find.Execute Replace:=wdReplaceOne Else Exit Do End If Loop lExit = False Do While lExit = False With Selection.Find .Text = "" .Replacement.Font.Superscript = False .Forward = True .Wrap = wdFindContinue .Format = True .MatchCase = False .MatchWholeWord = False .MatchWildcards = True .MatchSoundsLike = False .MatchAllWordForms = False End With If Selection.Find.Execute = True Then cReadstring = "" cReadstring = ActiveDocument.ActiveWindow.Selection.Text Selection.Find.Replacement.Text = ChrW(8805) Selection.Find.Execute Replace:=wdReplaceOne Else Exit Do End If Loop lExit = False Do While lExit = False With Selection.Find .Text = "" .Replacement.Font.Superscript = False .Forward = True .Wrap = wdFindContinue .Format = True .MatchCase = False .MatchWholeWord = False .MatchWildcards = True .MatchSoundsLike = False .MatchAllWordForms = False End With If Selection.Find.Execute = True Then cReadstring = "" cReadstring = ActiveDocument.ActiveWindow.Selection.Text Selection.Find.Replacement.Text = ChrW(8805) Selection.Find.Execute Replace:=wdReplaceOne Else Exit Do End If Loop lExit = False Do While lExit = False With Selection.Find .Text = "" .Replacement.Font.Superscript = False .Forward = True .Wrap = wdFindContinue .Format = True .MatchCase = False .MatchWholeWord = False .MatchWildcards = True .MatchSoundsLike = False .MatchAllWordForms = False End With If Selection.Find.Execute = True Then cReadstring = "" cReadstring = ActiveDocument.ActiveWindow.Selection.Text Selection.Find.Replacement.Text = "-" Selection.Find.Execute Replace:=wdReplaceOne Else Exit Do End If Loop lExit = False Do While lExit = False With Selection.Find .Text = "&#?????;" .Replacement.Font.Superscript = False .Forward = True .Wrap = wdFindContinue .Format = True .MatchCase = False .MatchWholeWord = False .MatchWildcards = True .MatchSoundsLike = False .MatchAllWordForms = False End With If Selection.Find.Execute = True Then cReadstring = "" cReadstring = ActiveDocument.ActiveWindow.Selection.Text Selection.Find.Replacement.Text = ChrW(Val(Mid(cReadstring, 3, 5))) Selection.Find.Execute Replace:=wdReplaceOne Else Exit Do End If Loop lExit = False Do While lExit = False With Selection.Find .Text = "&#??????;" .Replacement.Font.Superscript = False .Forward = True .Wrap = wdFindContinue .Format = True .MatchCase = False .MatchWholeWord = False .MatchWildcards = True .MatchSoundsLike = False .MatchAllWordForms = False End With If Selection.Find.Execute = True Then cReadstring = "" cReadstring = ActiveDocument.ActiveWindow.Selection.Text Selection.Find.Replacement.Text = ChrW(Val(Mid(cReadstring, 3, 6))) Selection.Find.Execute Replace:=wdReplaceOne Else Exit Do End If Loop For i = 1 To 25 lExit = False cString = "" For j = 1 To i cString = cString + "?" Next j Do While lExit = False With Selection.Find .Text = "??" + cString + "?/?" .Replacement.Font.Superscript = True .Replacement.Font.Subscript = False .Forward = True .Wrap = wdFindContinue .Format = True .MatchCase = False .MatchWholeWord = False .MatchWildcards = True .MatchSoundsLike = False .MatchAllWordForms = False End With If Selection.Find.Execute = True Then cReadstring = "" cReadstring = ActiveDocument.ActiveWindow.Selection.Text Selection.Find.Replacement.Text = Mid(cReadstring, 6, i) Selection.Find.Execute Replace:=wdReplaceOne Else Exit Do End If Loop Next i For i = 1 To 25 lExit = False cString = "" For j = 1 To i cString = cString + "?" Next j Do While lExit = False With Selection.Find .Text = "??" + cString + "?/?" .Replacement.Font.Superscript = False .Replacement.Font.Subscript = True .Forward = True .Wrap = wdFindContinue .Format = True .MatchCase = False .MatchWholeWord = False .MatchWildcards = True .MatchSoundsLike = False .MatchAllWordForms = False End With If Selection.Find.Execute = True Then cReadstring = "" cReadstring = ActiveDocument.ActiveWindow.Selection.Text Selection.Find.Replacement.Text = Mid(cReadstring, 6, i) Selection.Find.Execute Replace:=wdReplaceOne Else Exit Do End If Loop Next i For i = 1 To 25 lExit = False cString = "" For j = 1 To i cString = cString + "?" Next j Do While lExit = False With Selection.Find .Text = "??" + cString + "?/?" .Replacement.Font.Superscript = True .Replacement.Font.Subscript = False .Forward = True .Wrap = wdFindContinue .Format = True .MatchCase = False .MatchWholeWord = False .MatchWildcards = True .MatchSoundsLike = False .MatchAllWordForms = False End With If Selection.Find.Execute = True Then cReadstring = "" cReadstring = ActiveDocument.ActiveWindow.Selection.Text Selection.Find.Replacement.Text = Mid(cReadstring, 6, i) Selection.Find.Execute Replace:=wdReplaceOne Else Exit Do End If Loop Next i For i = 1 To 25 lExit = False cString = "" For j = 1 To i cString = cString + "?" Next j Do While lExit = False With Selection.Find .Text = "??" + cString + "?/?" .Replacement.Font.Superscript = False .Replacement.Font.Subscript = True .Forward = True .Wrap = wdFindContinue .Format = True .MatchCase = False .MatchWholeWord = False .MatchWildcards = True .MatchSoundsLike = False .MatchAllWordForms = False End With If Selection.Find.Execute = True Then cReadstring = "" cReadstring = ActiveDocument.ActiveWindow.Selection.Text Selection.Find.Replacement.Text = Mid(cReadstring, 6, i) Selection.Find.Execute Replace:=wdReplaceOne Else Exit Do End If Loop Next i For i = 1 To 150 lExit = False cString = "" For j = 1 To i cString = cString + "?" Next j Do While lExit = False With Selection.Find .Text = "??" + cString + "?/?" .Replacement.Font.Superscript = False .Replacement.Font.Subscript = False .Replacement.Font.Bold = True .Forward = True .Wrap = wdFindContinue .Format = True .MatchCase = False .MatchWholeWord = False .MatchWildcards = True .MatchSoundsLike = False .MatchAllWordForms = False End With If Selection.Find.Execute = True Then cReadstring = "" cReadstring = ActiveDocument.ActiveWindow.Selection.Text Selection.Find.Replacement.Text = Mid(cReadstring, 4, i) Selection.Find.Execute Replace:=wdReplaceOne Else Exit Do End If Loop Next i For i = 1 To 150 lExit = False cString = "" For j = 1 To i cString = cString + "?" Next j Do While lExit = False With Selection.Find .Text = "??" + cString + "?/?" .Replacement.Font.Superscript = False .Replacement.Font.Subscript = False .Replacement.Font.Bold = True .Forward = True .Wrap = wdFindContinue .Format = True .MatchCase = False .MatchWholeWord = False .MatchWildcards = True .MatchSoundsLike = False .MatchAllWordForms = False End With If Selection.Find.Execute = True Then cReadstring = "" cReadstring = ActiveDocument.ActiveWindow.Selection.Text Selection.Find.Replacement.Text = Mid(cReadstring, 4, i) Selection.Find.Execute Replace:=wdReplaceOne Else Exit Do End If Loop Next i For i = 1 To 150 lExit = False cString = "" For j = 1 To i cString = cString + "?" Next j Do While lExit = False With Selection.Find .Text = "??" + cString + "?/?" .Replacement.Font.Italic = True .Replacement.Font.Bold = False .Forward = True .Wrap = wdFindContinue .Format = True .MatchCase = False .MatchWholeWord = False .MatchWildcards = True .MatchSoundsLike = False .MatchAllWordForms = False End With If Selection.Find.Execute = True Then cReadstring = "" cReadstring = ActiveDocument.ActiveWindow.Selection.Text Selection.Find.Replacement.Text = Mid(cReadstring, 4, i) Selection.Find.Execute Replace:=wdReplaceOne Else Exit Do End If Loop Next i For i = 1 To 150 lExit = False cString = "" For j = 1 To i cString = cString + "?" Next j Do While lExit = False With Selection.Find .Text = "??" + cString + "?/?" .Replacement.Font.Italic = True .Replacement.Font.Bold = False .Forward = True .Wrap = wdFindContinue .Format = True .MatchCase = False .MatchWholeWord = False .MatchWildcards = True .MatchSoundsLike = False .MatchAllWordForms = False End With If Selection.Find.Execute = True Then cReadstring = "" cReadstring = ActiveDocument.ActiveWindow.Selection.Text Selection.Find.Replacement.Text = Mid(cReadstring, 4, i) Selection.Find.Execute Replace:=wdReplaceOne Else Exit Do End If Loop Next i For i = 1 To 150 lExit = False cString = "" For j = 1 To i cString = cString + "?" Next j Do While lExit = False With Selection.Find .Text = "??" + cString + "?/?" .Replacement.Font.Underline = True .Replacement.Font.Italic = False .Forward = True .Wrap = wdFindContinue .Format = True .MatchCase = False .MatchWholeWord = False .MatchWildcards = True .MatchSoundsLike = False .MatchAllWordForms = False End With If Selection.Find.Execute = True Then cReadstring = "" cReadstring = ActiveDocument.ActiveWindow.Selection.Text Selection.Find.Replacement.Text = Mid(cReadstring, 4, i) Selection.Find.Execute Replace:=wdReplaceOne Else Exit Do End If Loop Next i For i = 1 To 150 lExit = False cString = "" For j = 1 To i cString = cString + "?" Next j Do While lExit = False With Selection.Find .Text = "??" + cString + "?/?" .Replacement.Font.Underline = True .Replacement.Font.Italic = False .Forward = True .Wrap = wdFindContinue .Format = True .MatchCase = False .MatchWholeWord = False .MatchWildcards = True .MatchSoundsLike = False .MatchAllWordForms = False End With If Selection.Find.Execute = True Then cReadstring = "" cReadstring = ActiveDocument.ActiveWindow.Selection.Text Selection.Find.Replacement.Text = Mid(cReadstring, 4, i) Selection.Find.Execute Replace:=wdReplaceOne Else Exit Do End If Loop Next i Documents(actief).Activate ActiveDocument.Saved = True ActiveDocument.Close End Sub Sub Eventure() ' ' EVENTURE Macro ' Macro gemaakt op 29-08-2000 door Parthen IMpact ' Dim actief, fs, envstring, cTempDir Set fs = CreateObject("Scripting.FileSystemObject") envstring = Environ("TMP") If envstring = "" Then envstring = Environ("TEMP") End If If fs.fileexists(envstring + "\WORD.rtf") Then cTempDir = envstring Else If fs.fileexists("C:\TEMP\WORD.rtf") Then cTempDir = "C:\TEMP" Else If fs.fileexists("D:\TEMP\WORD.rtf") Then cTempDir = "D:\TEMP" Else If fs.fileexists("F:\TEMP\WORD.rtf") Then cTempDir = "F:\TEMP" Else If fs.fileexists("H:\TEMP\Word.rtf") Then cTempDir = "H:\TEMP" Else If fs.fileexists("K:\TEMP\Word.rtf") Then cTempDir = "K:\TEMP" Else If fs.fileexists("L:\TEMP\Word.rtf") Then cTempDir = "L:\TEMP" Else If fs.fileexists("P:\TEMP\Word.rtf") Then cTempDir = "P:\TEMP" Else If fs.fileexists("U:\TEMP\Word.rtf") Then cTempDir = "U:\TEMP" Else If fs.fileexists("N:\TEMP\Word.rtf") Then cTempDir = "N:\TEMP" End If End If End If End If End If End If End If End If End If End If Documents.Open FileName:=cTempDir + "\WORD.rtf", ConfirmConversions:=False, ReadOnly:= _ False, AddToRecentFiles:=False, PasswordDocument:="", PasswordTemplate:= _ "", Revert:=False, WritePasswordDocument:="", WritePasswordTemplate:="", _ Format:=wdOpenFormatAuto, Encoding:=1252 ActiveDocument.SaveAs FileName:=cTempDir + "\WORD.rtf", FileFormat:=wdFormatRTF, _ LockComments:=False, Password:="", AddToRecentFiles:=True, WritePassword _ :="", ReadOnlyRecommended:=False, EmbedTrueTypeFonts:=False, _ SaveNativePictureFormat:=False, SaveFormsData:=False, SaveAsAOCELetter:= _ False ActiveDocument.Close actief = ActiveDocument ActiveDocument.MailMerge.MainDocumentType = wdFormLetters ActiveDocument.MailMerge.OpenDataSource Name:=cTempDir + "\WORD.rtf", _ ConfirmConversions:=False, ReadOnly:=False, LinkToSource:=True, _ AddToRecentFiles:=False, PasswordDocument:="", PasswordTemplate:="", _ WritePasswordDocument:="", WritePasswordTemplate:="", Revert:=False, _ Format:=wdOpenFormatAuto, Connection:="", SQLStatement:="", SQLStatement1 _ :="" With ActiveDocument.MailMerge .Destination = wdSendToNewDocument .MailAsAttachment = False .MailAddressFieldName = "" .MailSubject = "" .SuppressBlankLines = True With .DataSource .FirstRecord = wdDefaultFirstRecord .LastRecord = wdDefaultLastRecord End With .Execute Pause:=True End With Documents(actief).Activate ActiveDocument.Saved = True ActiveDocument.Close ActiveWindow.Activate End Sub Sub EVEMAIL() ' EVENTURE_EMAIL Macro ' Macro opgenomen op 29-08-2000 door Parthen IMpact ' Dim actief, fs, envstring, cTempDir Set fs = CreateObject("Scripting.FileSystemObject") envstring = Environ("TMP") If envstring = "" Then envstring = Environ("TEMP") End If If fs.fileexists(envstring + "\WORD.rtf") Then cTempDir = envstring Else If fs.fileexists("C:\TEMP\WORD.rtf") Then cTempDir = "C:\TEMP" Else If fs.fileexists("D:\TEMP\WORD.rtf") Then cTempDir = "D:\TEMP" Else If fs.fileexists("F:\TEMP\WORD.rtf") Then cTempDir = "F:\TEMP" Else If fs.fileexists("H:\TEMP\Word.rtf") Then cTempDir = "H:\TEMP" Else If fs.fileexists("K:\TEMP\Word.rtf") Then cTempDir = "K:\TEMP" Else If fs.fileexists("L:\TEMP\Word.rtf") Then cTempDir = "L:\TEMP" Else If fs.fileexists("P:\TEMP\Word.rtf") Then cTempDir = "P:\TEMP" Else If fs.fileexists("U:\TEMP\Word.rtf") Then cTempDir = "U:\TEMP" Else If fs.fileexists("N:\TEMP\Word.rtf") Then cTempDir = "N:\TEMP" End If End If End If End If End If End If End If End If End If End If actief = ActiveDocument ActiveDocument.MailMerge.MainDocumentType = wdFormLetters ActiveDocument.MailMerge.OpenDataSource Name:=cTempDir + "\WORD.rtf", _ ConfirmConversions:=False, ReadOnly:=False, LinkToSource:=True, _ AddToRecentFiles:=False, PasswordDocument:="", PasswordTemplate:="", _ WritePasswordDocument:="", WritePasswordTemplate:="", Revert:=False, _ Format:=wdOpenFormatAuto, Connection:="", SQLStatement:="", SQLStatement1 _ :="" With ActiveDocument.MailMerge .Destination = wdSendToEmail .MailAsAttachment = False .MailAddressFieldName = "Email" .MailSubject = .DataSource.DataFields.Item(16) .SuppressBlankLines = True With .DataSource .FirstRecord = wdDefaultFirstRecord .LastRecord = wdDefaultLastRecord End With .Execute Pause:=True End With Documents(actief).Activate ActiveDocument.Saved = True ActiveDocument.Close Application.Quit End Sub Sub EVEPDF() ' EVENTURE_EMAIL Macro ' Macro opgenomen op 29-08-2000 door Parthen IMpact ' On Error Resume Next Dim actief, fs, envstring, cTempDir, cFile, appWord, NewDoc Set appWord = GetObject(, "Word.Application") Set fs = CreateObject("Scripting.FileSystemObject") envstring = Environ("TMP") If envstring = "" Then envstring = Environ("TEMP") End If If fs.fileexists(envstring + "\WORD.rtf") Then cTempDir = envstring Else If fs.fileexists("C:\TEMP\WORD.rtf") Then cTempDir = "C:\TEMP" Else If fs.fileexists("D:\TEMP\WORD.rtf") Then cTempDir = "D:\TEMP" Else If fs.fileexists("F:\TEMP\WORD.rtf") Then cTempDir = "F:\TEMP" Else If fs.fileexists("H:\TEMP\Word.rtf") Then cTempDir = "H:\TEMP" Else If fs.fileexists("K:\TEMP\Word.rtf") Then cTempDir = "K:\TEMP" Else If fs.fileexists("L:\TEMP\Word.rtf") Then cTempDir = "L:\TEMP" Else If fs.fileexists("P:\TEMP\Word.rtf") Then cTempDir = "P:\TEMP" Else If fs.fileexists("U:\TEMP\Word.rtf") Then cTempDir = "U:\TEMP" Else If fs.fileexists("N:\TEMP\Word.rtf") Then cTempDir = "N:\TEMP" End If End If End If End If End If End If End If End If End If End If ActiveDocument.MailMerge.MainDocumentType = wdFormLetters ActiveDocument.MailMerge.OpenDataSource Name:=cTempDir + "\WORD.rtf", _ ConfirmConversions:=False, ReadOnly:=True, LinkToSource:=True, _ AddToRecentFiles:=False, PasswordDocument:="", PasswordTemplate:="", _ WritePasswordDocument:="", WritePasswordTemplate:="", Revert:=False, _ Format:=wdOpenFormatAuto, Connection:="", SQLStatement:="", SQLStatement1 _ :="" With ActiveDocument.MailMerge .Destination = wdSendToNewDocument .SuppressBlankLines = True With .DataSource .FirstRecord = wdDefaultFirstRecord .LastRecord = wdDefaultLastRecord End With .Execute End With Evesplitter (cTempDir) ActiveDocument.Saved = True ActiveDocument.Close (wdDoNotSaveChanges) appWord.Quit SaveChanges:=wdDoNotSaveChanges Set appWord = Nothing End Sub Sub Evesplitter(cTempDir) Dim x As Long Dim Sections As Long Dim DocName As String Dim y As Long Dim z As Long Dim nI As Long Dim Doc As Document Dim NewDoc As Document Dim lMargin, rMargin, tMargin, bMargin As Long On Error GoTo Err_Handler Application.ScreenUpdating = False Application.DisplayAlerts = False Set fs = CreateObject("Scripting.FileSystemObject") Set Doc = ActiveDocument lMargin = Doc.PageSetup.LeftMargin rMargin = Doc.PageSetup.RightMargin tMargin = Doc.PageSetup.TopMargin bMargin = Doc.PageSetup.BottomMargin Sections = Doc.Sections.Count For x = 1 To (Sections - 1) DocName = cTempDir + "\PDFDocument" + LTrim$(Str$(x)) + ".pdf" Doc.Sections(x).Range.Copy Set NewDoc = Documents.Add With Documents(NewDoc).PageSetup .LeftMargin = lMargin .RightMargin = rMargin .TopMargin = tMargin .BottomMargin = bMargin End With With NewDoc .Range.PasteAndFormat wdFormatOriginalFormatting z = .Range.Characters.Count y = InStr(.Content, Chr(12)) If y < z Then .Content.Characters(y).Delete End If .SaveAs FileName:=DocName, FileFormat:=wdFormatPDF .Close SaveChanges:=wdDoNotSaveChanges For iWait = 1 To 10000 DoEvents Next iWait End With Set NewDoc = Nothing Next x Application.ScreenUpdating = True Application.DisplayAlerts = True Exit Sub Err_Handler: If Err.Number = 4198 Then If iErrCounter <= 2500 Then For iWait = 1 To 1000 DoEvents Next iWait ' MsgBox (Err.Description + " " + DocName + " could not be closed. We try again"), vbInformation, Err.Number & " regel " & Erl iErrCounter = iErrCounter + 1 Resume End If End If MsgBox (Err.Description + " " + DocName), vbInformation, Err.Number & " regel " & Erl Set NewDoc = Documents.Add With NewDoc .SaveAs FileName:=cTempDir + "\EveProblem.doc" .Close End With Resume Next End Sub