Combine two codes to run together - excel

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

Answer 2

Try taking a look at this and see if it helps. From what I understand you are just trying to call one function in the middle of another.
From the first sentence of that link: "To call a Sub procedure from another procedure, type the name of the procedure and include values for any required arguments."