Combine two codes to run together

Question

I have a code that I found to loop through all of the files in the folder named Loop_AllWordFiles_inFolder and it calls whatever code you put in to execute some kind of action on the word documents in your selected folder. This code will run.

However I run into a problem when I try to have it call upon the code.. I don't know how to make them run together. The code it's calling is called ExtractSubject which is the action I need executed. I found this code online which runs through one file at a time and I'm trying to combine it with the looping files.

I'm new to VBA and I'm not sure how to fix the ExtractSubject code so they can run together. My end goal is to have two columns one with the title of the file and then beside it in the next cell the subject which I will be extracting. Something like this 1

Also I can't open a file without this read-only pop-up2 so if anyone knows how to fix that it would be appreciated but this is not my main concern atm.

Here's the two codes:

    Option Explicit
    
    Dim wb As Workbook
    Dim path As String
    Dim myFile As String
    Dim myExtension As String
    Dim myFolder As FileDialog
    Dim wdApp As Object, wddoc As Object
    
    
    Sub Loop_AllWordFiles_inFolder()
    
    Set wdApp = CreateObject("Word.Application")
    
     
    'Optimize Macro Speed
    Application.ScreenUpdating = False
    Application.EnableEvents = False
    Application.Calculation = xlCalculationManual
    
    'Retrieve Target Folder Path From User
    Set myFolder = Application.FileDialog(msoFileDialogFolderPicker)
    
    With myFolder
        .Title = "Select A Target Folder"
        .AllowMultiSelect = False
        If .Show <> -1 Then GoTo NextCode
        path = .SelectedItems(1) & "\"
    End With
    
    ' if the User select "Cancel"
    NextCode:
    path = path
    If path = "" Then GoTo ResetSettings
    
    ' Target File Extension
    myExtension = "*.doc"
    
    ' Target Path with Ending Extention
    myFile = Dir(path & myExtension)
    
        
    ' Loop through all doc files in folder
    Do While myFile <> ""
        Set wddoc = wdApp.Documents.Open(fileName:=path & myFile)
    
        ' HERE you call your other routine
        Call ExtractSubject
    
        wddoc.Close SaveChanges:=False
        myFile = Dir
    Loop
    
    Application.DisplayAlerts = PrevDispAlerts
    
    MsgBox "Finished scanning all files in Folder " & path
    
    ResetSettings:
    
    ' Reset Macro Optimization Settings
    Application.EnableEvents = True
    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = True
    
    Set wdApp = Nothing
    
    End Sub
    
    
Sub ExtractSubject()
        
        Dim cDoc As Word.Document
        Dim cRng As Word.Range
        Dim i As Long
        i = 2
        
        Dim wordapp As Object
        Set wordapp = CreateObject("word.Application")
        wordapp.Documents.Open "c:\code practice\file1"
        wdApp.Visible = True
        
        Set wddoc = ActiveDocument
        Set cRng = wddoc.Content
        
        With cRng.Find
            .Forward = True
            .Text = "SUBJECT:"
            .Wrap = wdFindStop
            .Execute
           
                'Collapses a range or selection to the starting or ending position
                cRng.Collapse Word.WdCollapseDirection.wdCollapseEnd
                cRng.MoveEndUntil Cset:="JOB"
                Cells(i, 1) = cRng
                cRng.Collapse Word.WdCollapseDirection.wdCollapseEnd
                .Execute
                i = i + 1
           
        End With
        wordapp.Quit
        Set wordapp = Nothing
    
    End Sub

Answer 1

I think something like this should be close to what you're trying to do. Note you don't want all your variables as Globals - anything which needs to be shared between methods can be passed as an argument or returned as a function result.

Sub Loop_AllWordFiles_inFolder()
    Const FILE_EXT As String = ".doc"
    Dim wb As Workbook
    Dim path As String
    Dim myFile As String, theSubject As String
    Dim wdApp As Object, wdDoc As Object
    
    'Retrieve Target Folder Path From User
    With Application.FileDialog(msoFileDialogFolderPicker)
        .Title = "Select A Target Folder"
        .AllowMultiSelect = False
        If .Show = -1 Then path = .SelectedItems(1) & "\"
    End With
    If Len(path) = 0 Then Exit Sub
    
    'path = "C:\Temp\Test\"  'testing only
    
    myFile = Dir(path & "*" & FILE_EXT) ' Target Path with Ending Extention
    If Len(myFile) = 0 Then
        MsgBox "No Word files found"
        Exit Sub
    End If
    
    Set wdApp = CreateObject("Word.Application")
    wdApp.Visible = True
    
    Optimize '(don't really need this for this code though...)
    
    Do While myFile <> ""
        Set wdDoc = wdApp.Documents.Open(Filename:=path & myFile)
        theSubject = ExtractSubject(wdDoc) 'extract subject from wdDoc
        wdDoc.Close SaveChanges:=False
        
        If Len(theSubject) > 0 Then        'subject was found?
            Name path & myFile As path & theSubject & FILE_EXT 'rename the file
        Else
            'output any problems
            Debug.Print "Subject not found in '" & path & myFile & "'"
        End If
        
        myFile = Dir 'next file
    Loop
    
    wdApp.Quit       'no need to set to Nothing
    Optimize False   'turn off speed enhancements
    
    'Application.DisplayAlerts = PrevDispAlerts  '?????
    MsgBox "Finished scanning all files in Folder " & path
End Sub
    
'Return text between "SUBJECT:" and "JOB" in word document `wdDoc`
Function ExtractSubject(wdDoc As Word.document) As String
    Dim cRng As Word.Range
    Set cRng = wdDoc.content
    With cRng.Find
        .Forward = True
        .Text = "SUBJECT:"
        .Wrap = wdFindStop
        If .Execute() Then
            cRng.Collapse Word.WdCollapseDirection.wdCollapseEnd
            cRng.MoveEndUntil Cset:="JOB"
            ExtractSubject = Trim(cRng.Text)
        End If
    End With
End Function

'make changes to application settings to optimize macro speed in excel
Sub Optimize(Optional goFast As Boolean = True)
    With Application
        .ScreenUpdating = Not goFast
        .EnableEvents = Not goFast
        .Calculation = IIf(goFast, xlCalculationManual, xlCalculationAutomatic)
    End With
End Sub