Consulting

Page 1 of 3 1 2 3 LastLast
Results 1 to 20 of 42

Thread: [VBA Excel] To find word in Microsoft Word Table and copy Offsets to Excel Cells

  1. #1

    [VBA Excel] To find word in Microsoft Word Table and copy Offsets to Excel Cells

    Hello
    Is it possible to use Excel VBA on a Word Document, and after finding a table in that Word Document to search within that table (in its cells) for a word and copy some cells (Offsets) from the same column, but lower rows (like the Excel Offset) to Excel? Or to find the cell and copy its offset from the next column to Excel? In short can VBA Excel look for a word in a cell within a Word Table and get the offsets near it (below in or from next column) to be copied to Excel?

    Has anyone tried this? I know how to do it from Excel -> Excel but don't know how to do Word->Excel

    If it's possible I would really be grateful if someone could give an example of how to find a cell in a word table and then copy the cell from next column or the cell from the row below.


    For example if there is a Table in a Word Document like this

    Fruits Quantity
    Apples 5
    Pears 2
    Oranges 8

    Is it possible to look using an Excel VBA into the Word Document Table for "Fruits" and if fruits is found to copy Apples to Excel on A1? Or, alternatively to search for Apples within the Table and to copy 5 on B1 in Excel


    Many thanks
    John
    Last edited by johngalvin; 09-20-2019 at 04:30 PM.

  2. #2
    VBAX Expert Dave's Avatar
    Joined
    Mar 2005
    Posts
    611
    Location
    John it's very similar logic to the last post. You can trial this (it's still set up for multi-files)...
    Option Explicit
    Sub XLWordTable()
    Dim WrdApp As Object, Cnt As Integer, FileStr As String
    Dim WrdDoc As Object, TblCell As Variant, SearchWord As String
    Dim FSO As Object, FolDir As Object, FileNm As Object
    '*** SearchWord is case sensitive
    SearchWord = "Fruits"
    On Error GoTo ErFix
    Set WrdApp = CreateObject("Word.Application")
    WrdApp.Visible = False
    Set FSO = CreateObject("scripting.filesystemobject")
    '***change directory to suit
    Set FolDir = FSO.GetFolder("D:\testfolder")
    'loop files
    For Each FileNm In FolDir.Files
    If FileNm.Name Like "*" & ".docx" Then
    FileStr = CStr(FileNm)
    Set WrdDoc = WrdApp.Documents.Open(FileStr)
    'check if table exists
    If WrdApp.ActiveDocument.tables.Count < 1 Then
    GoTo Below
    End If
    'loop tables
    For Cnt = 1 To WrdApp.ActiveDocument.tables.Count
    'loop through table cells
    For Each TblCell In WrdApp.ActiveDocument.tables(Cnt).Range.Cells
    If InStr(TblCell.Range, SearchWord) Then
    Sheets("sheet1").Range("A" & 1) = WrdApp.ActiveDocument.tables(Cnt).Cell(TblCell.RowIndex + 1, TblCell.ColumnIndex)
    'remove pilcrow
    Sheets("sheet1").Range("A" & 1) = Application.WorksheetFunction.Clean(Sheets("sheet1").Range("A" & 1))
    Sheets("sheet1").Range("B" & 1) = WrdApp.ActiveDocument.tables(Cnt).Cell(TblCell.RowIndex + 1, TblCell.ColumnIndex + 1)
    Sheets("sheet1").Range("B" & 1) = Application.WorksheetFunction.Clean(Sheets("sheet1").Range("B" & 1))
    'WrdApp.ActiveDocument.Tables(Cnt).Delete
    GoTo Below
    End If
    Next TblCell
    Next Cnt
    Below:
    'close and save doc
    WrdApp.ActiveDocument.Close savechanges:=True
    Set WrdDoc = Nothing
    End If
    Next FileNm
    Set FolDir = Nothing
    Set FSO = Nothing
    WrdApp.Quit
    Set WrdApp = Nothing
    MsgBox "Finished"
    Exit Sub
    ErFix:
    On Error GoTo 0
    MsgBox "error"
    Set FolDir = Nothing
    Set FSO = Nothing
    Set WrdDoc = Nothing
    WrdApp.Quit
    Set WrdApp = Nothing
    End Sub

  3. #3
    Hey Dave !
    Thank you so much for your input ! That was brilliant, and works like charm!

    The last thing, I tried stopping at the 1st encountered table after the word search rather than looping but it sort of doesen't work, I've attached the code below

    Many thanks,
    John

    Tried Something new as you can see below, yields the Error "The file appears to be corrupted"

    Option Explicit
    Sub XLWordTables()
    Dim WrdApp As Object, Cnt As Integer, FileStr As String
    Dim WrdDoc As Object, TblCell As Variant, SearchWord As String
    Dim FSO As Object, FolDir As Object, FileNm As Object
    
    
    
    Set WrdApp = CreateObject("Word.Application")
    WrdApp.Visible = False
    Set FSO = CreateObject("scripting.filesystemobject")
    '***change directory to suit
    Set FolDir = FSO.GetFolder("C:\Users\John\Desktop\Studio")
    'loop files
    For Each FileNm In FolDir.Files
    If FileNm.Name Like "*" & ".docx" Then
    FileStr = CStr(FileNm)
    Set WrdDoc = WrdApp.Documents.Open(FileStr)
    
             
             
             
            Dim TableRange As Word.Range
            
    
    
    
        Const WholeContent As Integer = 1
    
    
    
    
    With WrdDoc.StoryRanges(WholeContent)
    
    
    
                With .Find
                    .Forward = True
                    .ClearFormatting
                    .MatchWholeWord = True
                    .MatchCase = True
                    .Wrap = wdFindContinue
                    .Text = "Solo"
                    .Execute
                    
       
                End With
       
           
                Set TableRange = .Duplicate.Next(unit:=wdTable)
         
    
        With TableRange.Tables(1)
    
    
    
    For Each TblCell In WrdApp.ActiveDocument.Tables(1).Range.Cells
    
    
    Sheets("WM").Range("A" & 8) = WrdApp.ActiveDocument.Tables(1).Cell(TblCell.RowIndex, TblCell.ColumnIndex + 1)
    'remove pilcrow
    Sheets("WM").Range("A" & 8) = Application.WorksheetFunction.Clean(Sheets("WM").Range("A" & 8))
    
    
    Next TblCell
    
    
    End With
    End With
    End If
    Next
    End Sub
    Last edited by johngalvin; 09-21-2019 at 10:22 AM.

  4. #4
    Quote Originally Posted by johngalvin View Post
    Hey Dave !
    Thank you so much for your input ! That was brilliant, and works like charm!

    The last thing, I tried stopping at the 1st encountered table after finding the WordSearch rather than looping the tables, but it sort of doesen't work, I've attached the code below

    Many thanks,
    John

    Tried Something new as you can see below, yields the Error "The file appears to be corrupted"

    Option Explicit
    Sub XLWordTables()
    Dim WrdApp As Object, Cnt As Integer, FileStr As String
    Dim WrdDoc As Object, TblCell As Variant, SearchWord As String
    Dim FSO As Object, FolDir As Object, FileNm As Object
    
    
    
    Set WrdApp = CreateObject("Word.Application")
    WrdApp.Visible = False
    Set FSO = CreateObject("scripting.filesystemobject")
    '***change directory to suit
    Set FolDir = FSO.GetFolder("C:\Users\John\Desktop\Studio")
    'loop files
    For Each FileNm In FolDir.Files
    If FileNm.Name Like "*" & ".docx" Then
    FileStr = CStr(FileNm)
    Set WrdDoc = WrdApp.Documents.Open(FileStr)
    
             
             
             
            Dim TableRange As Word.Range
            
    
    
    
        Const WholeContent As Integer = 1
    
    
    
    
    With WrdDoc.StoryRanges(WholeContent)
    
    
    
                With .Find
                    .Forward = True
                    .ClearFormatting
                    .MatchWholeWord = True
                    .MatchCase = True
                    .Wrap = wdFindContinue
                    .Text = "Solo"
                    .Execute
                    
       
                End With
       
           
                Set TableRange = .Duplicate.Next(unit:=wdTable)
         
    
        With TableRange.Tables(1)
    
    
    
    For Each TblCell In WrdApp.ActiveDocument.Tables(1).Range.Cells
    
    
    Sheets("Sheet1").Range("A" & 1) = WrdApp.ActiveDocument.Tables(1).Cell(TblCell.RowIndex, TblCell.ColumnIndex + 1)
    'remove pilcrow
    Sheets("Sheet1").Range("A" & 1) = Application.WorksheetFunction.Clean(Sheets("Sheet1").Range("A" & 1))
    
    
    Next TblCell
    
    
    End With
    End With
    End If
    Next
    End Sub
    Ahh I realized that this code (above) will try to get the next table which is wrong (should grab current table), so please ignore the above post (#3). I tried editing a bit the code to stop at the 1st encountered table after the SearchWord was found (rather than doing the table loop and stopping and last encountered table), below is the Code that I tried, but it won't fill the Cell in Excel. Your input would be greatly appreciated. Many thanks ! John

    Option Compare Text'<To stop Case sensitivity 
    Dim SearchWord As String
    '*** SearchWord is case sensitive
    SearchWord = "Solo"
    'check if table exists
    If WrdApp.ActiveDocument.Tables.Count < 1 Then
    GoTo Below
    End If
    
    If InStr(TblCell.Range, SearchWord) Then
    'loop through table cells
    For Each TblCell In WrdApp.ActiveDocument.Tables(1).Range.Cells
    
    
    Sheets("Sheet1").Range("A" & 1) = WrdApp.ActiveDocument.Tables(1).Cell(TblCell.RowIndex, TblCell.ColumnIndex + 1)
    Sheets("Sheet1").Range("A" & 1) = Application.WorksheetFunction.Clean(Sheets("Sheet1").Range("A" & 1))
    
    
    Next TblCell
    End If
    End Sub
    Last edited by johngalvin; 09-21-2019 at 12:57 PM.

  5. #5
    VBAX Expert Dave's Avatar
    Joined
    Mar 2005
    Posts
    611
    Location
    John I don't understand. The code exits after it does only 1 table and then moves on to the next document? (See the "Goto Below" code) Dave

  6. #6
    Hi Dave.
    Yes to your question. It searches the document for the SearchWord and when found it gets the 1st encountered table , it doesen't have to loop through all the tables and end up with the last encountered one.

    For example if in the Word Document we are searching (SearchWord) for "Solo" it should go to the 1st table where "Solo" appears, get the next column near it and put it in Cell A1 Excel. It shouldn't loop all tables and end up to go to the last table where "Solo" appears.

    Many thanks
    John

  7. #7
    VBAX Expert Dave's Avatar
    Joined
    Mar 2005
    Posts
    611
    Location
    Again John it doesn't loop any tables after it finds the table with the search word... it moves to the next file and again places the information in the same place (A1& B1) ie. there is no code to capture info from multiple files. The code was only to show U the "how to" and it seemed the code from your previous post was handy for adjustment. I'm guessing this is the actual problem. Dave

  8. #8
    Hello Dave

    Speaking of a single Word Document file.
    There are multiple tables within a Word Document file that include the same SearchWord and I noticed that it just copied the next column to A1 from the last table in which the SearchWord appeared, and not from the 1st one, and that's why I tried to adjust it. I don't need it to capture from multiple files. One file is enough for this, but I have to make it to take from the 1st encountered table after the SearchWord was found and not to loop until the last table within the same File. Do you think something can be done about that?

    Best,
    John
    Last edited by johngalvin; 09-21-2019 at 02:07 PM.

  9. #9
    VBAX Expert Dave's Avatar
    Joined
    Mar 2005
    Posts
    611
    Location
    U can trial this. Change the file address to suit. Dave
    Option Explicit
    Sub XLWordTable()
    Dim WrdApp As Object, Cnt As Integer, FileStr As String
    Dim WrdDoc As Object, TblCell As Variant, SearchWord As String
    Dim FSO As Object, FolDir As Object, FileNm As Object
    '*** SearchWord is case sensitive
    SearchWord = "Fruits"
    'On Error GoTo ErFix
    Set WrdApp = CreateObject("Word.Application")
    WrdApp.Visible = False
    'Set FSO = CreateObject("scripting.filesystemobject")
    '***change directory to suit
    'Set FolDir = FSO.GetFolder("D:\testfolder")
    'loop files
    'For Each FileNm In FolDir.Files
    'If FileNm.Name Like "*" & ".docx" Then
    'FileStr = CStr(FileNm)
    '********** change address to suit
    FileStr = "D:\testfolder\tabletest.docx"
    Set WrdDoc = WrdApp.Documents.Open(FileStr)
    'check if table exists
    If WrdApp.ActiveDocument.tables.Count < 1 Then
    GoTo Below
    End If
    'loop tables
    For Cnt = 1 To WrdApp.ActiveDocument.tables.Count
    'loop through table cells
    For Each TblCell In WrdApp.ActiveDocument.tables(Cnt).Range.Cells
    If InStr(TblCell.Range, SearchWord) Then
    Sheets("sheet1").Range("A" & 1) = WrdApp.ActiveDocument.tables(Cnt).Cell(TblCell.RowIndex + 1, TblCell.ColumnIndex)
    'remove pilcrow
    Sheets("sheet1").Range("A" & 1) = Application.WorksheetFunction.Clean(Sheets("sheet1").Range("A" & 1))
    Sheets("sheet1").Range("B" & 1) = WrdApp.ActiveDocument.tables(Cnt).Cell(TblCell.RowIndex + 1, TblCell.ColumnIndex + 1)
    Sheets("sheet1").Range("B" & 1) = Application.WorksheetFunction.Clean(Sheets("sheet1").Range("B" & 1))
    'WrdApp.ActiveDocument.Tables(Cnt).Delete
    GoTo Below
    End If
    Next TblCell
    Next Cnt
    Below:
    'close and save doc
    WrdApp.ActiveDocument.Close savechanges:=True
    Set WrdDoc = Nothing
    'End If
    'Next FileNm
    'Set FolDir = Nothing
    'Set FSO = Nothing
    WrdApp.Quit
    Set WrdApp = Nothing
    MsgBox "Finished"
    Exit Sub
    ErFix:
    On Error GoTo 0
    MsgBox "error"
    'Set FolDir = Nothing
    'Set FSO = Nothing
    Set WrdDoc = Nothing
    WrdApp.Quit
    Set WrdApp = Nothing
    End Sub

  10. #10
    That's perfect, Dave ! Thank you, works like charm. I guess the thread can be marked as Solved now.

    Many thanks!

  11. #11
    VBAX Expert Dave's Avatar
    Joined
    Mar 2005
    Posts
    611
    Location
    You are again welcome John. Have a nice day. Dave
    ps. U the thread starter marks them as solved

  12. #12
    Hey guys
    The problem is sort of solved, but can anyone please help out with copying directly the field from the Word Document( from the next column from the Word Table )without the Pilcrow symbol to Excel Cell? At the moment it is copying the field from the Word Table with a Pilcrow symbol to Excel, then it deletes it. Is there any way to copy directly without symbol (pilcrow)?



    Option Explicit
    
    Sub WordTabletoExcel()
        Dim WrdApp AsObject, Cnt AsInteger, FileStr AsString
        Dim WrdDoc AsObject, TblCell AsVariant
        Dim FSO AsObject, FolDir AsObject, FileNm AsObject
    
        OnErrorGoTo ErFix
        Set WrdApp = CreateObject("Word.Application")
        WrdApp.Visible =False
        Set FSO = CreateObject("scripting.filesystemobject")
        Set FolDir = FSO.GetFolder("C:\Users\John\Desktop\Fruits")
        'loop files
        ForEach FileNm In FolDir.Files
        If FileNm.Name Like"*"&".docx"Then
        FileStr =CStr(FileNm)
        Set WrdDoc = WrdApp.Documents.Open(FileStr)
        'check if table exists
        If WrdApp.ActiveDocument.Tables.Count <1Then
        GoTo Below
        EndIf
    
    
    
        Dim SearchWord AsString
        SearchWord ="Fruits"
    
        For Cnt =1To WrdApp.ActiveDocument.Tables.Count
        'loop through table cells
        ForEach TblCell In WrdApp.ActiveDocument.Tables(Cnt).Range.Cells
        If InStr(TblCell.Range, SearchWord)Then
    'remove pilcrow
        Sheets(Sheet1").Range("A" & 1) = WrdApp.ActiveDocument.Tables(Cnt).Cell(TblCell.RowIndex, TblCell.ColumnIndex + 1)
        Sheets("Sheet1").Range("A" & 1) = Application.WorksheetFunction.Clean(Sheets("Sheet1").Range("A" & 1))
    
        End If
        Next TblCell
        Next Cnt
         End Sub
    This is how it is currently copying
    https://imgur.com/Mbtw5Iz
    And after a while it deletes that symbol

    Was wondering if it could copy directly from Word table to Excel Cell without involving symbol and then deleting it.


    Many thanks

    John
    Last edited by johngalvin; 09-22-2019 at 04:18 AM.

  13. #13
    Knowledge Base Approver VBAX Guru macropod's Avatar
    Joined
    Jul 2008
    Posts
    3,888
    Location
    Try:
    Sheets(Sheet1").Range("A" & 1) = Split(WrdDoc.Tables(Cnt).Cell(TblCell.RowIndex, TblCell.ColumnIndex + 1), vbCr, 0)
    Cheers
    Paul Edstein
    [MS MVP - Word]

  14. #14
    Hello Paul
    That was quick, thanks!
    I tried what you've suggested, the cell remains blank unfortunately.
    This is now the code:

    Dim SearchWord As String
    SearchWord = "Fruits"
    
    
    For Cnt = 1 To WrdApp.ActiveDocument.Tables.Count
    'loop through table cells
    For Each TblCell In WrdApp.ActiveDocument.Tables(Cnt).Range.Cells
    If InStr(TblCell.Range, SearchWord) Then
    Sheets("Sheet1").Range("A" & 1) = Split(WrdDoc.Tables(Cnt).Cell(TblCell.RowIndex, TblCell.ColumnIndex + 1), vbCr, 0)
    Sheets("Sheet1").Range("A" & 1) = Application.WorksheetFunction.Clean(Sheets("Sheet1").Range("A" & 1))
    End If
    Next TblCell
    Next Cnt
    The issue is that now it doesen't fill anymore the Cell A1, with anything. It used to put there the text with the symbol at the end and then delete the symbol after like 5-10 seconds or so, but it could be better if this could be done in 1 step, directly putting the text into cell without symbol and without the need to delete the symbol

    John

  15. #15
    Knowledge Base Approver VBAX Guru macropod's Avatar
    Joined
    Jul 2008
    Posts
    3,888
    Location
    Well, unless your Word cell has an empty paragraph at the start, there should be some output. You also don't need:
    Sheets("Sheet1").Range("A" & 1) = Application.WorksheetFunction.Clean(Sheets("Sheet1").Range("A" & 1))
    Cheers
    Paul Edstein
    [MS MVP - Word]

  16. #16
    Hello Paul,

    Thanks for your message.

    I adapted the code as following:
    Unfortunately the cell A1 remains blank, so no Output, looked for sensitiveness of the text and of the code, all seems fine. I even tried on other Excel cell, but still blank. Even created a New Word Document in which I typed some random text then the Table in which I put the SearchWord "Fruits", and on the next Column "Apples", but still the cell remained blank, no output.

    Dim SearchWord As String
    SearchWord = "Fruits"
    
    
    For Cnt = 1 To WrdApp.ActiveDocument.Tables.Count
    'loop through table cells
    For Each TblCell In WrdApp.ActiveDocument.Tables(Cnt).Range.Cells
    If InStr(TblCell.Range, SearchWord) Then
    Sheets("Sheet1").Range("A" & 1) = Split(WrdDoc.Tables(Cnt).Cell(TblCell.RowIndex, TblCell.ColumnIndex + 1), vbCr, 0)
    End If
    Next TblCell
    Next Cnt
    If I put back the outdated code, the cell A1 would be filled with Apples[Symbol] and after like 10 seconds the [Symbol] would disappear, but there must be a way to do it in 1 step such as copying the text directly without Symbol

    Dim SearchWord AsString
        SearchWord ="Fruits"
    
        For Cnt =1To WrdApp.ActiveDocument.Tables.Count
        'loop through table cells
        ForEach TblCell In WrdApp.ActiveDocument.Tables(Cnt).Range.Cells
        If InStr(TblCell.Range, SearchWord)Then
    'remove pilcrow
        Sheets(Sheet1").Range("A" & 1) = WrdApp.ActiveDocument.Tables(Cnt).Cell(TblCell.RowIndex, TblCell.ColumnIndex + 1)
        Sheets("Sheet1").Range("A" & 1) = Application.WorksheetFunction.Clean(Sheets("Sheet1").Range("A" & 1))
    
        End If
        Next TblCell
        Next Cnt
    Last edited by johngalvin; 09-22-2019 at 05:45 AM.

  17. #17
    Knowledge Base Approver VBAX Guru macropod's Avatar
    Joined
    Jul 2008
    Posts
    3,888
    Location
    Try the following:
    Sub GetTableData()
    'Note: this code requires a reference to the Word object model.
    'See under the VBE's Tools|References.
    Application.ScreenUpdating = False
    Dim wdApp As New Word.Application, wdDoc As Word.Document, wdTbl As Word.Table
    Dim strFolder As String, strFile As String, WkSht As Worksheet, c As Long, r As Long
    strFolder = GetFolder: If strFolder = "" Then GoTo ErrExit
    Set WkSht = ActiveSheet
    r = WkSht.Cells(WkSht.Rows.Count, 1).End(xlUp).Row
    strFile = Dir(strFolder & "\*.docx", vbNormal)
    While strFile <> ""
      Set wdDoc = wdApp.Documents.Open(Filename:=strFolder & "\" & strFile, AddToRecentFiles:=False, Visible:=False)
      r = r + 1: c = 1
      WkSht.Cells(r, c).Value = Split(strFile, ".docx")(0)
      With wdDoc
        For Each wdTbl In .Tables
          With wdTbl.Range
            With .Find
              .Text = "Fruits"
              .Wrap = wdFindStop
              .Execute
            End With
            If .Find.Found = True Then
              c = c + 1
              WkSht.Cells(r, c).Value = Split(wdTbl.Cell(.Cells(1).RowIndex + 1, .Cells(1).ColumnIndex + 1).Range.Text, vbCr)(0)
            End If
          End With
        Next
        .Close SaveChanges:=False
      End With
      strFile = Dir()
    Wend
    ErrExit:
    wdApp.Quit
    Set wdDoc = Nothing: Set wdApp = Nothing: Set WkSht = Nothing
    Application.ScreenUpdating = True
    End Sub
    
    Function GetFolder() As String
        Dim oFolder As Object
        GetFolder = ""
        Set oFolder = CreateObject("Shell.Application").BrowseForFolder(0, "Choose a folder", 0)
        If (Not oFolder Is Nothing) Then GetFolder = oFolder.Items.Item.Path
        Set oFolder = Nothing
    End Function
    
    PS:
    Split(WrdDoc.Tables(Cnt).Cell(TblCell.RowIndex, TblCell.ColumnIndex + 1), vbCr, 0)

    should have been
    Split(WrdDoc.Tables(Cnt).Cell(TblCell.RowIndex, TblCell.ColumnIndex + 1), vbCr)(0)
    Last edited by macropod; 09-22-2019 at 04:02 PM. Reason: Code Revision
    Cheers
    Paul Edstein
    [MS MVP - Word]

  18. #18
    Hi Paul,


    I activated Word 16 Reference from Tools, I pointed to the Folder where the Word Document (.docx) is, I ran it, but yields this: "Run time error '1004' Unable to set the Text property of the Range class", pointing to this line:
     WkSht.Cells(r, c).Text = Split(strFile, ".docx")(0)
    I tried changing from .Text to .Value, but it won't output anything

    I guess I'm doing something wrong, I checked the .Text and seems to be fine though.

    Other than that, indeed
    Split(WrdDoc.Tables(Cnt).Cell(TblCell.RowIndex, TblCell.ColumnIndex + 1), vbCr)(0)
    now fills in that Cell, but it still take some time like 10-15 seconds, like before, just that it doesen't display the symbol, so I guess the above code with .Text can be a bit faster?

    Many thanks,
    John
    Last edited by johngalvin; 09-22-2019 at 07:37 AM.

  19. #19
    Knowledge Base Approver VBAX Guru macropod's Avatar
    Joined
    Jul 2008
    Posts
    3,888
    Location
    Try changing both instances of:
    WkSht.Cells(r, c).Text
    to:
    WkSht.Cells(r, c).Value
    Code in post 17 revised.
    Cheers
    Paul Edstein
    [MS MVP - Word]

  20. #20
    Hi Paul,

    I tried with the updated code, and double checked that both instances to have .value instead of .text

    The code says that is running, no errors, but unfortunately doesen't fill any cell in Excel, so no output.

    Thank you!

    Best,
    John

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •