none
VBA to Vb net help, search code RRS feed

  • Question

  • Hello! So I got some help making the first code under here. What it does is that i searches a database (excel workbook) and uses word search function to find any words in the workbook and highlights them (I also have a code for replacement). And some friends asked me if they also could use that code, so I decided to make an Add-In since it would be hard for them to open vbe in word (although I have never used VS before). Here is the code from VBA and a function that the sub uses:

    Sub Search()
    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
    Options.DefaultHighlightColorIndex = wdYellow
    StrWkBkNm = "C:\Users\" & Environ("Username") & "\Documents\NA\NA.xlsx"
    If Dir(StrWkBkNm) = "" Then
      MsgBox "Cannot find the designated workbook: " & StrWkBkNm, vbExclamation
      Exit Sub
    End If
    ' Test whether Excel is already running.
    On Error Resume Next
    bStrt = False ' Flag to record if we start Excel, so we can close it later.
    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("Ark1")
        ' Find the last-used row in column A.
        ' Add 1 to get the next row for data-entry.
        iDataRow = .Cells(.Rows.Count, 1).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("A" & i)) <> vbNullString Then
            xlFList = xlFList & "|" & Trim(.Range("A" & i))
            xlRList = xlRList & "|" & Trim(.Range("B" & 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 = True
          .MatchCase = False
          .Replacement.Highlight = True
          .Wrap = wdFindStop
          .Execute
        End With
        'Replace the found text, asking first
        Do While .Find.Found
          .Duplicate.Select
          Selection.Range.HighlightColorIndex = wdYellow
          .Collapse wdCollapseEnd
          .Find.Execute
        Loop
      End With
    Next
    End Sub
    
    Function IsFileLocked(strFileName As String) As Boolean
      On Error Resume Next
      Open strFileName For Binary Access Read Write Lock Read Write As #1
      Close #1
      IsFileLocked = Err.Number
      Err.Clear
    End Function

    Is there anyone that can help me convert it? I tried to convert it, but got stuck:

    Sub Search()
    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
            Dim selection As Word.Selection
            Dim oDoc As Word.Document
            Dim oWord As Word.Application = Globals.ThisAddIn.Application
            oDoc = oWord.ActiveDocument
            'Options.DefaultHighlightColorIndex = wdYellow
            StrWkBkNm = "C:\Users\" & Environ("Username") & "\Documents\NA\NA.xlsx"
            If Dir(StrWkBkNm) = "" Then
                MsgBox("Kan ikke finne arbeidsboken: " & StrWkBkNm, vbExclamation)
                Exit Sub
            End If
            ' Test whether Excel is already running.
            On Error Resume Next
            bStrt = False ' Flag to record if we start Excel, so we can close it later.
            xlApp = GetObject(, "Excel.Application")
            'Start Excel if it isn't running
            If xlApp Is Nothing Then
                xlApp = CreateObject("Excel.Application")
                If xlApp Is Nothing Then
                    MsgBox("Kan ikke starte 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
                        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("Denne arbeidsboken er i bruk" & vbCr & "Vennligst prøv igjen.", vbExclamation, "File in use")
                    'Exit Sub
                    'End If
                    ' The file is available, so open it.
                    xlWkBk = .Workbooks.Open(FileName:=StrWkBkNm)
                    If xlWkBk Is Nothing Then
                        MsgBox("Kan ikke åpne:" & vbCr & StrWkBkNm, vbExclamation)
                        Exit Sub
                    End If
                End If
                ' Update the workbook.
                With xlWkBk.Worksheets("Ark1")
                    ' Find the last-used row in column A.
                    ' Add 1 to get the next row for data-entry.
                    iDataRow = .Cells(.Rows.Count, 1).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("A" & i)) <> vbNullString Then
                            xlFList = xlFList & "|" & Trim(.Range("A" & i))
                            xlRList = xlRList & "|" & Trim(.Range("B" & i))
                        End If
                    Next
                End With
                If bFound = True Then xlWkBk.Close = False
                If bStrt = True Then .Quit()
            End With
            ' Release Excel object memory
            xlWkBk = Nothing : xlApp = Nothing
            'Process each word from the List
            For i = 1 To UBound(Split(xlFList, "|"))
                With oDoc.Range
                    With .Find
                        .Text = Split(xlFList, "|")(i)
                        .ClearFormatting()
                        .Replacement.ClearFormatting()
                        .MatchWholeWord = True
                        .MatchCase = False
                        .Replacement.Highlight = True
                        .Wrap = WdFindWrap.wdFindStop
                        .Execute()
                    End With
                    'Replace the found text, asking first
                    Do While .Find.Found
                        .Duplicate.Select()
                        selection.Range.HighlightColorIndex = WdColorIndex.wdYellow
                        .Collapse = WdCollapseDirection.wdCollapseEnd
                        .Find.Execute()
                    Loop
                End With
            Next
        End Sub

    Any help would be appreciated, and if I have posted in the wrong section please let me know!

    Saturday, April 13, 2013 2:09 PM

Answers

  • Hi Buster,

    According to the code in the second section, it doesn't seems like a VSTO add-in to me. What you've done is more like a Word automation project. Anyway, if you want to work through the code, a few things I'd like to mention:

    > Please add the reference for Word object library. From the com tab in the "Add references" dialog.

    > You use oDoc As Word.Document, and also based on your description, I assume that you intend to develop the project for word application and the search action is for Word application. If it is true, then you need to modify the following code:

            xlApp = GetObject(, "Excel.Application")
            'Start Excel if it isn't running
            If xlApp Is Nothing Then
                xlApp = CreateObject("Excel.Application")
                If xlApp Is Nothing Then
                    MsgBox("Kan ikke starte Excel.", vbExclamation)
                    Exit Sub
                Else
                End If
                ' Record that we've started Excel.
                bStrt = True
            End If

    We should change it for Word application, namely, "Excel.Application" should be "Word.Application" in this case.

    > Remove the code that relates to Excel.Application and give the code a try.

    Tell me the process and let us know if you still have any problem.

    Good day.


    Yoyo Jiang[MSFT]
    MSDN Community Support | Feedback to us
    Develop and promote your apps in Windows Store
    Please remember to mark the replies as answers if they help and unmark them if they provide no help.

    Tuesday, April 16, 2013 3:07 AM
    Moderator