Member Avatar

Hello everyone,

First of all I would like to thank everyone for all their efforts in helping us newbies in solving our problems when it comes to coding. It has been a while since I have seeked some help from this forum or any other for that matter. I stopped coding since I graduated college a few years ago.

My problem is actually how I can transfer certain words or sentences from one cell to another. Keywords that I can reference in the comment cells are:

I need to grab just these text highlighted in green from the cell containing the sentences below, and transfer it to another cell.

The actual text is this:
Synopsis : The remote Windows host has a denial of service vulnerability. Description : The remote host is affected by a vulnerability in the SMB service that can reportedly be abused by a remote, unauthenticated attacker to cause the host to stop responding until manually restarted. This vulnerability depends on access to a Windows file share, but might not necessarily require credentials. Solution : Microsoft has released a set of patches for Vista, 2008, 7, and 2008 R2 : Risk factor : High / CVSS Base Score : 7.8 (CVSS2#AV:N/AC:L/Au:N/C:N/I:N/A:C) CVE : CVE-2011-1267 BID : 48185 Other references : OSVDB:72936,MSFT:MS11-048

The program I am trying to develop is to format a NESSUS scan report into a readable report in excel. The progrm is designed to open ".nbe" extension files....

Here is my code so far for the whole program, I know its a bit messy because it has really been a while since I done any programming, and its still a work in progress. The solution will go in the FormatCell() sub..... Thanks in advance for all your help..Below is my code so far... It is a bit messy as I mentioned its been awhile since I have done any coding.

Imports Microsoft.Office.Interop.Excel
Imports Microsoft.Office.Core
Imports System.IO

Public Class Form1
    Dim sMyFile As String
    Dim oExcel As Object
    Dim oSheet As Excel.Worksheet
    Dim rSearchRange As Range

    Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click

        Dim MyFileOpen As New System.Windows.Forms.OpenFileDialog
        Dim bExOccured As Boolean
        Dim retVal As DialogResult

            ' does not add an extension to a file name if the user omits the extension
            MyFileOpen.AddExtension = True

            'dialog box does not allow multiple files to be selected
            MyFileOpen.Multiselect = False

            MyFileOpen.InitialDirectory = (System.Environment.GetFolderPath(Environment.SpecialFolder.Desktop))
            MyFileOpen.Filter = "Nessus Scan Result|*.nbe"

            retVal = MyFileOpen.ShowDialog()
            If retVal = DialogResult.OK Then

                If MyFileOpen.CheckFileExists = True And MyFileOpen.CheckPathExists = True Then
                    sMyFile = MyFileOpen.FileName
                    RichTextBox1.Text = sMyFile
                End If
            End If

        Catch ex1 As AccessViolationException
            bExOccured = True
        Catch ex As Exception
            bExOccured = True
            If bExOccured = True Then
                MsgBox("Program executed with some errors!!!")
            End If
        End Try
    End Sub

    Private Sub Button3_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button3.Click


    End Sub

    Private Sub Button4_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button4.Click

        ' Private sub varible declaration
        Dim msg As String
        Dim title As String
        Dim style As MsgBoxStyle
        Dim response As MsgBoxResult

        ' Define message.
        msg = "Are you sure you want to quit?"
        style = MsgBoxStyle.YesNo
        ' Define title.
        title = "Quit Nessus2Excel"
        ' Display message.
        response = MsgBox(msg, style, title)
        ' User chose Yes.
        If response = MsgBoxResult.Yes Then
        End If

    End Sub

    Private Sub Button2_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button2.Click

        'Declare an array to place the text in
        Dim ColumnArray(,) As Integer = New Integer(,) {{1, 2}, {2, 1}, {3, 1}, {4, 1}, {5, 1}, {6, 1}, {7, 1}}
        Dim Cstring As String
        Dim j As Integer = 200

        oExcel = New Excel.Application

        'Open the file and format the cells for the worksheet
        If RichTextBox1.Text = "" Then
            MsgBox("No Files Selected ", MsgBoxStyle.Information, "Nessus2excel")
            'Start a new workbook in Excel
            oExcel.Workbooks.OpenText(Filename:=RichTextBox1.Text, Origin:=437, StartRow:=1, _
     DataType:=1, TextQualifier:=1, ConsecutiveDelimiter:=False, Tab:=True, Semicolon:=False, _
     Comma:=False, Space:=False, Other:=True, OtherChar:="|", FieldInfo:=ColumnArray, TrailingMinusNumbers:=True)

            oExcel.Visible = True
            oSheet = oExcel.ActiveSheet

            'This loop will delete unecessary cells
            For i = 1000 To 1 Step -1
                Cstring = Convert.ToString(oSheet.Cells(i, 1).Value)
                If Cstring = "timestamps" Then

                    'This code will search for empty cells and delete it
                    rSearchRange = oSheet.UsedRange.Columns(1) 'for example
                    If oExcel.WorksheetFunction.CountBlank(rSearchRange) Then _
                End If
            Next i
            Call FormatCells()
        End If

    End Sub

    Public Sub FormatCells()

        oExcel.Selection.Insert(Shift:=Excel.XlDirection.xlToRight, _

        Call FormatText()

    End Sub

    Public Sub FormatText()

        'Dim cPlugin As String
        'Dim cPort As String

        'Replace "\n" characters in the worksheet
        oExcel.Selection.Replace(What:="\n", Replacement:=" ", LookAt:=Excel.XlLookAt.xlPart, _
            SearchOrder:=Excel.XlSearchOrder.xlByRows, MatchCase:=False, SearchFormat:=False, _

        'Sorting data based on column D:D
        oExcel.Worksheets(1).Sort.SortFields.Add(Key:=oExcel.Range( _
            "D1:D46"), SortOn:=Excel.XlSortOn.xlSortOnValues, Order:=Excel.XlSortOrder.xlAscending, DataOption:= _
        With oExcel.Worksheets(1).Sort
            .Header = Excel.XlYesNoGuess.xlGuess
            .MatchCase = False
            .Orientation = Excel.XlSortOrder.xlAscending
            .SortMethod = Excel.XlSortMethod.xlPinYin
        End With

        Call MergeAlikeCells()
        Call ReleaseExcel()

    End Sub

    Public Sub MergeAlikeCells()

        'Variables for this class
        Dim cPlugin As String
        Dim cSamePlugin
        Dim sHostname As String
        Dim s2Hostname As String
        Dim i As Integer

        'Arranging the cells with same findings 
        For j = oExcel.ActiveSheet.UsedRange.Rows.Count - 1 To 1 Step -1
            cPlugin = Convert.ToString(oSheet.Cells(j, 4).Value)
            sHostname = Convert.ToString(oSheet.Cells(j, 1).Value)
            i = j + 1
            cSamePlugin = Convert.ToString(oSheet.Cells(i, 4).Value)
            s2Hostname = Convert.ToString(oSheet.Cells(i, 1).Value)
            If cSamePlugin = cPlugin Then
                oSheet.Cells(j, 1).Value = sHostname + "," + s2Hostname
                oSheet.Cells(i, 1).Value = " "
                If oSheet.Cells(i, 1).Value = " " Then
                End If
            End If
        Next j

    End Sub

    Public Sub ReleaseExcel()

        oSheet = Nothing
        oExcel = Nothing

    End Sub
End Class