locked
Find and comment macro with wildcards RRS feed

  • Question

  • While posting on the Microsoft community board, I got a tip that I should also post my issues here. 

    Recently I have experienced two problems with my macros, and I can not find a solution. It has been working fine in the past, but now it crashes. When I manually run the macro, it find and comments, but it does that infinitive times until it crashes.  

    The search strings that the macro is searching for are these: 

    Når [! ]@ var fremme 
    Det [! ]@ var litt redd for 
    Når [! ]@ kom inn i klasserommet 
    Da [! ]@ kom inn i klasserommet 
    Da [! ]@ våkna 
    Når [! ]@ kom dit 
    Da [! ]@ kom dit 
    I sekundet [! ]@ gikk inn døra 
    Med engang [! ]@ gikk inn døra
    Da [! ]@ kom hjem 
    [! ]@ står opp av senga og det første jeg ser 
    For at vi skal vite at det er eventyr 
    Når [! ]@ trengte penger 
    Alle dere som er her 
    Hvis dere ikke gir meg penger 

    Are any of you capable of spotting where the code is wrong? 

    My second problem is very similar. It's the same macro, but with different search strings and comments, but it duplicates the comment for each string it finds.

    [Nn]år [! ]@ kom
    [Nn]år [! ]@ [a-å]@(et)>
    [Nn]år [! ]@ var
    [Nn]år [! ]@ fikk
    [Nn]år [! ]@ [! ]@ var
    [Nn]år [! ]@ har kommet
    [Nn]år [! ]@ [a-å]@(dde)>
    [Nn]år [! ]@ [a-å]@(te)>
    [Nn]år [! ]@ tok
    [Nn]år [! ]@ [a-å]@(a)>
     

    Sub kommafeil_bokmål()
    '
    '
    '
    ' Søker igjennom alle feil som ligger under bokmål, rad I. Merker feil med rød.
    ' Rad 10



    Application.ScreenUpdating = False
    Dim xlApp As Object, xlWkBk As Object, StrWkBkNm As String
    Dim bStrt As Boolean, iDataRow As Long, bFound As Boolean
    Dim xlFList As String, xlRList As String, i As Long, Rslt
    StrWkBkNm = "\\sarpedia.sarpsborg.com\DavWWWRoot\arbeidsrom\enhet-gralum-ungdomsskole\Delte dokumenter\ord som ligger i makro.xlsx"
    If Dir(StrWkBkNm) = "" Then
      MsgBox "Cannot find the designated workbook: " & StrWkBkNm, vbExclamation
      Exit Sub
    End If
    ' Sjekker om Excel er startet.
    On Error Resume Next
    bStrt = False ' Viser at excel er aktiv og vi kan stenge dette senere.
    Set xlApp = GetObject(, "Excel.Application")
    'Start Excel if it isn't running
    If xlApp Is Nothing Then
      Set xlApp = CreateObject("Excel.Application")
      If xlApp Is Nothing Then
        MsgBox "Can't start Excel.", vbExclamation
        Exit Sub
      Else
      End If
      ' Record that we've started Excel.
      bStrt = True
    End If
    On Error GoTo 0
    'Check if the workbook is open.
    bFound = False
    With xlApp
      'Hide our Excel session
      If bStrt = True Then .Visible = False
      For Each xlWkBk In .Workbooks
        If xlWkBk.FullName = StrWkBkNm Then ' It's open
          Set xlWkBk = xlWkBk
          bFound = True
          Exit For
        End If
      Next
      ' If not open by the current user.
      If bFound = False Then
        ' Check if another user has it open.
        If IsFileLocked(StrWkBkNm) = True Then
          ' Report and exit if true
          MsgBox "The Excel workbook is in use." & vbCr & "Please try again later.", vbExclamation, "File in use"
          Exit Sub
        End If
        ' The file is available, so open it.
        Set xlWkBk = .Workbooks.Open(FileName:=StrWkBkNm)
        If xlWkBk Is Nothing Then
          MsgBox "Cannot open:" & vbCr & StrWkBkNm, vbExclamation
          Exit Sub
        End If
      End If
      ' Update the workbook.
      With xlWkBk.Worksheets("bokmål")
        ' Find the last-used row in column A.
        ' Add 1 to get the next row for data-entry.
        iDataRow = .Cells(.Rows.Count, 9).End(-4162).Row ' -4162 = xlUp
        ' Output the captured data.
        For i = 1 To iDataRow
          ' Skip over empty fields to preserve the underlying cell contents.
          If Trim(.Range("I" & i)) <> vbNullString Then
            xlFList = xlFList & "|" & Trim(.Range("I" & i))
          End If
        Next
      End With
      If bFound = True Then xlWkBk.Close False
      If bStrt = True Then .Quit
    End With
    ' Release Excel object memory
    Set xlWkBk = Nothing: Set xlApp = Nothing
    'Process each word from the List
    For i = 1 To UBound(Split(xlFList, "|"))
      With ActiveDocument.Range
        With .Find
          .Text = Split(xlFList, "|")(i)
          .ClearFormatting
          .Replacement.ClearFormatting
          .MatchWholeWord = False
          .MatchCase = False
          .MatchWildcards = True
          .Replacement.Highlight = True
          .Wrap = wdFindStop
          .Execute
        End With
        'Replace the found text, asking first
        Do While .Find.Found
        i = i + 1
           .Duplicate.Select
         .Comments.Add Range:=.Duplicate, Text:="Alltid komma når en leddsetning står først i en helsetning"
        .Collapse wdCollapseEnd
        .Find.Execute
        Loop
      End With
    Next
    Application.ScreenUpdating = True
    End Sub

    Monday, May 15, 2017 6:39 AM

All replies