Excel Macro to pull and List data from a Word file.

[BishopDesigns]

Good Morning!

I'm attempting the write a macro that will
1. Prompt me to select a file (.NC is the file type that opens with Microsoft Word)
2. The macro then opens the selected NC file and reads its content line by line.
3. For each line, it checks if it starts with "T" followed by a number.
4. If a line matches the criteria, the T value is extracted and added to a collection to ensure uniqueness. Example line has "T5M6" the T value is "T5" or "T6M6" the T value is "T6"
5. After processing the entire file, the unique T values are listed in Excel on Sheet1, starting from cell B2.

Is this something, someone can help me with or is it even possible?

 

[HighAndWilder]

Good Morning!

I'm attempting the write a macro that will
1. Prompt me to select a file (.NC is the file type that opens with Microsoft Word)
2. The macro then opens the selected NC file and reads its content line by line.
3. For each line, it checks if it starts with "T" followed by a number.
4. If a line matches the criteria, the T value is extracted and added to a collection to ensure uniqueness. Example line has "T5M6" the T value is "T5" or "T6M6" the T value is "T6"
5. After processing the entire file, the unique T values are listed in Excel on Sheet1, starting from cell B2.

Is this something, someone can help me with or is it even possible?

Are you able to save the file that is loaded into Word as a text file and then open this in Excel and save as an Excel workbook?

You could then just use a simple formula to identify the 'T' values.

 

[BishopDesigns]

This is what I've been able to do

Sub OpenFile()
    Dim filePath As String
   
    ' Prompt the user to select a NC file
    With Application.FileDialog(msoFileDialogFilePicker)
        .Title = "Select an NC file"
        .Filters.Add "Text Files", "*.NC"
        If .Show = -1 Then ' If the user selects a file
            filePath = .SelectedItems(1)
        Else
            MsgBox "No file selected. Operation canceled.", vbExclamation
            Exit Sub
        End If
    End With
   
    ' Open the selected NC file
    Workbooks.OpenText Filename:=filePath, DataType:=xlDelimited, Tab:=False
   
    ' Additional code can be added here to manipulate the data or perform other tasks
       
    ActiveCell.Columns("A:A").EntireColumn.Select
    Selection.Copy
    'ActiveWorkbook.Close
    Windows("Tool List.xlsm").Activate
    Sheets("GCode").Select
    ActiveCell.Range("A1").Select
    ActiveSheet.Paste
   
    ' View List and Print List
   
    Sheets("Sheet1").Select
    'Range("A1:B21").Select
    'Application.CutCopyMode = False
    'Selection.PrintOut Copies:=1, Collate:=True
   

   
End Sub

I have a few steps commented out because they caused the Macro to fail.
'Range("A1:B21").Select
'Application.CutCopyMode = False
'Selection.PrintOut Copies:=1, Collate:=True

 

[rlv01]

Perhaps something similar to this.

Sub OpenFile()
    Dim filePath As String, TextLine As String
    Dim WB As Workbook
    Dim destWS As Worksheet
    Dim RowIndx As Long, I As Long, UniqueToolCount As Long
    Dim SD As Object

    On Error Resume Next
    Set WB = ActiveWorkbook 'Workbooks("Tool List.xlsm")
    Set destWS = WB.Worksheets("GCode")
    On Error GoTo 0
    
    If WB Is Nothing Then
        MsgBox "Cannot find required workbook", vbCritical
        Exit Sub
    End If
    
    If destWS Is Nothing Then
        MsgBox "Cannot find required worksheet", vbCritical
        Exit Sub
    End If
    
    ' Prompt the user to select a NC file
    With Application.FileDialog(msoFileDialogFilePicker)
        .Title = "Select an NC file"
        .Filters.Add "Text Files", "*.NC"
        If .Show = -1 Then ' If the user selects a file
            filePath = .SelectedItems(1)
        Else
            MsgBox "No file selected. Operation canceled.", vbExclamation
            Exit Sub
        End If
    End With
    
    Set SD = CreateObject("Scripting.dictionary")
    
    ' Open the selected NC file
    Open filePath For Input Access Read As #1           ' Open text file for read only.
    
    Do While Not EOF(1)
        Line Input #1, TextLine
        TextLine = Trim(TextLine)
        If Left(TextLine, 1) = "T" And IsNumeric(Mid(TextLine, 2, 1)) Then
            KeyStr = "T" & Mid(TextLine, 2, 1)
            If Not SD.exists(KeyStr) Then    'Unique key value, not already in the dictionary
                SD.Add KeyStr, ""
            End If
        End If
    Loop
    Close #1                                          ' Close file.
    
    With destWS.Cells
        .ClearContents
        .Cells(1, 1) = "Tool No"
        .Cells(1, 2) = "Tool Desc"
        
        RowIndx = 1
        UniqueToolCount = SD.Count
        
        If UniqueToolCount > 0 Then
            For I = 0 To UniqueToolCount - 1
                RowIndx = RowIndx + 1
                .Cells(RowIndx, 1) = I + 1
                .Cells(RowIndx, 2) = SD.Keys()(I)
            Next I
            destWS.Columns.AutoFit
        Else
            MsgBox "No tools were found in file " & filePath
        End If
    End With
End Sub

 

[HighAndWilder]

This is what I've been able to do

Sub OpenFile()
    Dim filePath As String
  
    ' Prompt the user to select a NC file
    With Application.FileDialog(msoFileDialogFilePicker)
        .Title = "Select an NC file"
        .Filters.Add "Text Files", "*.NC"
        If .Show = -1 Then ' If the user selects a file
            filePath = .SelectedItems(1)
        Else
            MsgBox "No file selected. Operation canceled.", vbExclamation
            Exit Sub
        End If
    End With
  
    ' Open the selected NC file
    Workbooks.OpenText Filename:=filePath, DataType:=xlDelimited, Tab:=False
  
    ' Additional code can be added here to manipulate the data or perform other tasks
      
    ActiveCell.Columns("A:A").EntireColumn.Select
    Selection.Copy
    'ActiveWorkbook.Close
    Windows("Tool List.xlsm").Activate
    Sheets("GCode").Select
    ActiveCell.Range("A1").Select
    ActiveSheet.Paste
  
    ' View List and Print List
  
    Sheets("Sheet1").Select
    'Range("A1:B21").Select
    'Application.CutCopyMode = False
    'Selection.PrintOut Copies:=1, Collate:=True
  

  
End Sub

I have a few steps commented out because they caused the Macro to fail.
'Range("A1:B21").Select
'Application.CutCopyMode = False
'Selection.PrintOut Copies:=1, Collate:=True

A different approach here using an advanced filter.

Public Sub subOpenFile()
Dim filePath As String
Dim WsMain As Worksheet
Dim WbToolList As Workbook
Dim Ws As Worksheet
Dim WsToolList As Worksheet

  ActiveWorkbook.Save
    
  Set WbToolList = fncWorkbookOpen("Tool List.xlsm")
   
  If Not WbToolList Is Nothing Then
    Set WsToolList = fncWorksheetExists(WbToolList, "GCode", True)
  Else
    MsgBox "Workbook '" & "Tool List.xlsm" & "' not open.", vbOKOnly, "Warning!"
    Exit Sub
  End If
     
  ' Prompt the user to select a NC file
  With Application.FileDialog(msoFileDialogFilePicker)
    .Title = "Select an NC file."
    .Filters.Add "Text Files", "*.NC"
    If .Show = -1 Then ' If the user selects a file
      filePath = .SelectedItems(1)
    Else
      MsgBox "No file selected. Operation canceled.", vbExclamation
      Exit Sub
    End If
  End With
          
  Application.ScreenUpdating = False
    
  ' Open the selected NC file.
  Workbooks.OpenText Filename:=filePath, DataType:=xlDelimited, Tab:=False
    
  Set Ws = ActiveSheet
  
  With Ws.Range("A1").CurrentRegion.Offset(0, 1)
    .Formula2 = "=IF(AND(LEFT(A1,1)=""T"",ISNUMBER(VALUE(MID(A1,2,1)))),TRUE,FALSE)"
    .Value = .Value
  End With
    
  With Ws
    .Range("A1").EntireRow.Insert
    .Range("A1:E1").Value = Array("Tool List", "Check", "", "Tool List", "Check")
    .Range("E2") = "True"
  End With
    
  With WbToolList.Worksheets("GCode")
    Ws.Range("A1").CurrentRegion.AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=Ws.Range( _
      "D1:E2"), CopyToRange:=.Range("A1"), Unique:=True
    .Columns("B").Delete
  End With
    
  If WsToolList.Range("A2").Value = "" Then
    MsgBox "No tools were found in file : " & vbCrLf & vbCrLf & filePath, vbOKOnly, "Warning!"
  End If
    
  ActiveWorkbook.Close savechanges:=False
     
  Application.ScreenUpdating = True
    
End Sub

Public Function fncWorkbookOpen(strWorkbookName As String) As Workbook
Dim Wb As Workbook

  For Each Wb In Application.Workbooks
    If Wb.Name = strWorkbookName Then
      Set fncWorkbookOpen = Workbooks(strWorkbookName)
    End If
  Next Wb

End Function

Public Function fncWorksheetExists(Wb As Workbook, strWorksheetName As String, blnCreate As Boolean) As Worksheet
Dim Ws As Worksheet
Dim blnExists As Boolean

  For Each Ws In Wb.Worksheets
    If Ws.Name = strWorksheetName Then
      blnExists = True
      Set fncWorksheetExists = Wb.Worksheets(strWorksheetName)
      Exit For
    End If
  Next Ws
  
  If Not blnExists And blnCreate Then
    Worksheets.Add after:=Wb.Sheets(Sheets.Count)
    ActiveSheet.Name = strWorksheetName
    Set fncWorksheetExists = Wb.Worksheets(strWorksheetName)
  End If

End Function