Copy content controls across all files in same folder

[NaRa]

I am very new to VBA and am having some issues. I am working on a VBA code that will open files one by one; create content controls (in the same locations); save the file; close and repeat until all files have been updated. (Edit: I have about 45 files to add these Content controls to which are all POs in the exact same format; the only thing that changes is the $ amounts. Will potentially have hundreds if not thousands to pull data from)

**Shooting for Plain Text**

I first recorded myself adding the content controls and had this VBA script


Sub ContentControl2()
'
' ContentControl2 Macro
'
'
Selection.MoveDown Unit:=wdLine, Count:=1
Selection.MoveRight Unit:=wdCharacter, Count:=1
Selection.MoveUp Unit:=wdLine, Count:=2
Selection.MoveRight Unit:=wdCharacter, Count:=21
Selection.MoveLeft Unit:=wdCharacter, Count:=1
Selection.MoveRight Unit:=wdCharacter, Count:=10, Extend:=wdExtend
Selection.Range.ContentControls.Add (wdContentControlText)
Selection.MoveDown Unit:=wdLine, Count:=2
Selection.MoveRight Unit:=wdCharacter, Count:=1
Selection.MoveLeft Unit:=wdCharacter, Count:=9
Selection.MoveUp Unit:=wdLine, Count:=1
Selection.MoveLeft Unit:=wdCharacter, Count:=2
Selection.MoveLeft Unit:=wdCharacter, Count:=10, Extend:=wdExtend
Selection.Range.ContentControls.Add (wdContentControlText)
Selection.MoveDown Unit:=wdLine, Count:=7
Selection.MoveLeft Unit:=wdCharacter, Count:=46
Selection.MoveDown Unit:=wdLine, Count:=21
Selection.MoveRight Unit:=wdCharacter, Count:=274
Selection.MoveRight Unit:=wdCharacter, Count:=150
Selection.MoveRight Unit:=wdCharacter, Count:=10, Extend:=wdExtend
Selection.Range.ContentControls.Add (wdContentControlText)
Selection.MoveRight Unit:=wdCharacter, Count:=282
Selection.MoveRight Unit:=wdCharacter, Count:=41, Extend:=wdExtend
Selection.Range.ContentControls.Add (wdContentControlText)
Selection.MoveRight Unit:=wdCharacter, Count:=84
Selection.MoveRight Unit:=wdCharacter, Count:=7, Extend:=wdExtend
Selection.Range.ContentControls.Add (wdContentControlText)
ActiveDocument.Save
ActiveWindow.Close
End Sub

I played with it some and made this code here which does not give me an error but doesn't make any content controls in any of the files; then when I try to open the first doc in the folder I have to open in "read only" unless I use the task manager to kill word first.


Sub ContentControls()'
' ContentControls Macro
' Loop
'
Dim wdAPP As New Word.Application
Dim myDoc As Word.Document
Dim MyFolder As String, StrFile As String


MyFolder = "C:\Users\mesmith\Desktop\SQL Practice\CC Practice"
Application.ScreenUpdating = False


If MyFolder = "" Then Exit Sub
Set wdAPP = CreateObject("word.Application")
StrFile = Dir(MyFolder & "\*.docx", vbNormal)


While StrFile <> ""


Set myDoc = wdAPP.Documents.Open(FileName:=MyFolder & "\" & StrFile, Visible:=False)


Selection.MoveDown Unit:=wdLine, Count:=1
Selection.MoveRight Unit:=wdCharacter, Count:=1
Selection.MoveUp Unit:=wdLine, Count:=2
Selection.MoveRight Unit:=wdCharacter, Count:=21
Selection.MoveLeft Unit:=wdCharacter, Count:=1
Selection.MoveRight Unit:=wdCharacter, Count:=10, Extend:=wdExtend
Selection.Range.ContentControls.Add (wdContentControlText)
Selection.MoveDown Unit:=wdLine, Count:=2
Selection.MoveRight Unit:=wdCharacter, Count:=1
Selection.MoveLeft Unit:=wdCharacter, Count:=9
Selection.MoveUp Unit:=wdLine, Count:=1
Selection.MoveLeft Unit:=wdCharacter, Count:=2
Selection.MoveLeft Unit:=wdCharacter, Count:=10, Extend:=wdExtend
Selection.Range.ContentControls.Add (wdContentControlText)
Selection.MoveDown Unit:=wdLine, Count:=7
Selection.MoveLeft Unit:=wdCharacter, Count:=46
Selection.MoveDown Unit:=wdLine, Count:=21
Selection.MoveRight Unit:=wdCharacter, Count:=274
Selection.MoveRight Unit:=wdCharacter, Count:=150
Selection.MoveRight Unit:=wdCharacter, Count:=10, Extend:=wdExtend
Selection.Range.ContentControls.Add (wdContentControlText)
Selection.MoveRight Unit:=wdCharacter, Count:=282
Selection.MoveRight Unit:=wdCharacter, Count:=41, Extend:=wdExtend
Selection.Range.ContentControls.Add (wdContentControlText)
Selection.MoveRight Unit:=wdCharacter, Count:=84
Selection.MoveRight Unit:=wdCharacter, Count:=7, Extend:=wdExtend
Selection.Range.ContentControls.Add (wdContentControlText)

End
myDoc.Close SaveChanges:=True
StrFile = Dir()
Wend
wdAPP.Quit
Set myDoc = Nothing
Set wdAPP = Nothing
Application.ScreenUpdating = True

End Sub



Any and all help is very much appreciated..... I apologize if the code is a jumbled mess.

[gmayor]

Without seeing the document and without knowing exactly what it is that you are trying to achieve, I am not going to begin to decipher the mass of selections, however your code does loop through the files in the folder and it does insert content controls. There are a couple of issues. First of all, why are you creating a new Word application? You are already working in Word. Use that application. You have an End command before the end which is unnecessary and leaves a hidden file open. There is no error handling, so you might want to at least count the content controls in the document before you process as an already processed document will cause the whole things to crash.

It is better to work with the files visible until you are sure it works.


Option Explicit

Sub ContentControls() '

Dim myDoc As Word.Document
Dim MyFolder As String, StrFile As String
Dim fso As Object

MyFolder = "C:\Users\mesmith\Desktop\SQL Practice\CC Practice\"

Application.ScreenUpdating = False
Set fso = CreateObject("Scripting.FileSystemObject")
If Not (fso.FolderExists(MyFolder)) Then
MsgBox "The named folder does not exist"
Set fso = Nothing
Exit Sub
End If
StrFile = Dir(MyFolder & "*.docx", vbNormal)

While StrFile <> ""
Set myDoc = Documents.Open(FileName:=MyFolder & StrFile, Visible:=True)
If myDoc.ContentControls.Count = 0 Then
Selection.MoveDown Unit:=wdLine, Count:=1
Selection.MoveRight Unit:=wdCharacter, Count:=1
Selection.MoveUp Unit:=wdLine, Count:=2
Selection.MoveRight Unit:=wdCharacter, Count:=21
Selection.MoveLeft Unit:=wdCharacter, Count:=1
Selection.MoveRight Unit:=wdCharacter, Count:=10, Extend:=wdExtend
Selection.Range.ContentControls.Add (wdContentControlText)
Selection.MoveDown Unit:=wdLine, Count:=2
Selection.MoveRight Unit:=wdCharacter, Count:=1
Selection.MoveLeft Unit:=wdCharacter, Count:=9
Selection.MoveUp Unit:=wdLine, Count:=1
Selection.MoveLeft Unit:=wdCharacter, Count:=2
Selection.MoveLeft Unit:=wdCharacter, Count:=10, Extend:=wdExtend
Selection.Range.ContentControls.Add (wdContentControlText)
Selection.MoveDown Unit:=wdLine, Count:=7
Selection.MoveLeft Unit:=wdCharacter, Count:=46
Selection.MoveDown Unit:=wdLine, Count:=21
Selection.MoveRight Unit:=wdCharacter, Count:=274
Selection.MoveRight Unit:=wdCharacter, Count:=150
Selection.MoveRight Unit:=wdCharacter, Count:=10, Extend:=wdExtend
Selection.Range.ContentControls.Add (wdContentControlText)
Selection.MoveRight Unit:=wdCharacter, Count:=282
Selection.MoveRight Unit:=wdCharacter, Count:=41, Extend:=wdExtend
Selection.Range.ContentControls.Add (wdContentControlText)
Selection.MoveRight Unit:=wdCharacter, Count:=84
Selection.MoveRight Unit:=wdCharacter, Count:=7, Extend:=wdExtend
Selection.Range.ContentControls.Add (wdContentControlText)
End If
myDoc.Close SaveChanges:=True

StrFile = Dir()
Wend
Set myDoc = Nothing
Set fso = Nothing
Application.ScreenUpdating = True
End Sub

[NaRa]

Without seeing the document and without knowing exactly what it is that you are trying to achieve, I am not going to begin to decipher the mass of selections, however your code does loop through the files in the folder and it does insert content controls. There are a couple of issues. First of all, why are you creating a new Word application? You are already working in Word. Use that application. You have an End command before the end which is unnecessary and leaves a hidden file open. There is no error handling, so you might want to at least count the content controls in the document before you process as an already processed document will cause the whole things to crash.

It is better to work with the files visible until you are sure it works.


Option Explicit

Sub ContentControls() '

Dim myDoc As Word.Document
Dim MyFolder As String, StrFile As String
Dim fso As Object

MyFolder = "C:\Users\mesmith\Desktop\SQL Practice\CC Practice\"

Application.ScreenUpdating = False
Set fso = CreateObject("Scripting.FileSystemObject")
If Not (fso.FolderExists(MyFolder)) Then
MsgBox "The named folder does not exist"
Set fso = Nothing
Exit Sub
End If
StrFile = Dir(MyFolder & "*.docx", vbNormal)

While StrFile <> ""
Set myDoc = Documents.Open(FileName:=MyFolder & StrFile, Visible:=True)
If myDoc.ContentControls.Count = 0 Then
Selection.MoveDown Unit:=wdLine, Count:=1
Selection.MoveRight Unit:=wdCharacter, Count:=1
Selection.MoveUp Unit:=wdLine, Count:=2
Selection.MoveRight Unit:=wdCharacter, Count:=21
Selection.MoveLeft Unit:=wdCharacter, Count:=1
Selection.MoveRight Unit:=wdCharacter, Count:=10, Extend:=wdExtend
Selection.Range.ContentControls.Add (wdContentControlText)
Selection.MoveDown Unit:=wdLine, Count:=2
Selection.MoveRight Unit:=wdCharacter, Count:=1
Selection.MoveLeft Unit:=wdCharacter, Count:=9
Selection.MoveUp Unit:=wdLine, Count:=1
Selection.MoveLeft Unit:=wdCharacter, Count:=2
Selection.MoveLeft Unit:=wdCharacter, Count:=10, Extend:=wdExtend
Selection.Range.ContentControls.Add (wdContentControlText)
Selection.MoveDown Unit:=wdLine, Count:=7
Selection.MoveLeft Unit:=wdCharacter, Count:=46
Selection.MoveDown Unit:=wdLine, Count:=21
Selection.MoveRight Unit:=wdCharacter, Count:=274
Selection.MoveRight Unit:=wdCharacter, Count:=150
Selection.MoveRight Unit:=wdCharacter, Count:=10, Extend:=wdExtend
Selection.Range.ContentControls.Add (wdContentControlText)
Selection.MoveRight Unit:=wdCharacter, Count:=282
Selection.MoveRight Unit:=wdCharacter, Count:=41, Extend:=wdExtend
Selection.Range.ContentControls.Add (wdContentControlText)
Selection.MoveRight Unit:=wdCharacter, Count:=84
Selection.MoveRight Unit:=wdCharacter, Count:=7, Extend:=wdExtend
Selection.Range.ContentControls.Add (wdContentControlText)
End If
myDoc.Close SaveChanges:=True

StrFile = Dir()
Wend
Set myDoc = Nothing
Set fso = Nothing
Application.ScreenUpdating = True
End Sub


Thank you very much for your help sir!! I did not realize I was opening another instance of word...that would explain the issue with having to kill word in the task manager. That was not my intention. After playing with the code yesterday it felt as if I was approaching the situation all wrong, also when making things visible I saw the content controls were being added to a "strange" area. Which more than likely came from opening the second instance of word. Thank you again for your help and now back to the drawing board!!

Much appreciated sir!

I will see if I can post a document to give you a better idea of the areas I'm trying to grab. Have a great day!

[NaRa]

This is a edited version of the document I'm using if I need to add more back to it I will happily fill in bunk address's and what not.

[gmayor]

The following will process documents that match the sample. I have included a test macro to establish that it works with the actual document, before running the batch, allowing you to make changes to the locations as necessary.

Option Explicit

Sub TestMacro()
Dim myDoc As Word.Document
Set myDoc = ActiveDocument
If myDoc.ContentControls.Count = 0 And _
myDoc.Tables.Count = 4 Then
AddControls myDoc
Else
MsgBox "The Active Document is not compatible, or already has the content controls set."
End If
End Sub

Sub ContentControls()
Dim myDoc As Word.Document
Dim MyFolder As String, StrFile As String
Dim fso As Object

MyFolder = "C:\Users\mesmith\Desktop\SQL Practice\CC Practice\"
Application.ScreenUpdating = False
Set fso = CreateObject("Scripting.FileSystemObject")
If Not (fso.FolderExists(MyFolder)) Then
MsgBox "The named folder does not exist"
Set fso = Nothing
Exit Sub
End If
StrFile = Dir(MyFolder & "*.docx", vbNormal)

While StrFile <> ""
Set myDoc = Documents.Open(FileName:=MyFolder & StrFile, Visible:=True)
If myDoc.ContentControls.Count = 0 And _
myDoc.Tables.Count = 4 Then
AddControls myDoc
End If
myDoc.Close SaveChanges:=True
StrFile = Dir()
Wend
lbl_Exit:
Set myDoc = Nothing
Set fso = Nothing
Exit Sub
End Sub

Sub AddControls(oDoc As Document)
Dim oTable As Table
Dim oCell As Range
Dim oRng As Range
Dim oCC As ContentControl
Set oRng = oDoc.Range
With oRng.Find
Do While .Execute(FindText:="PO Number - ")
oRng.Collapse 0
oRng.MoveEndUntil Chr(13)
Set oCC = oDoc.ContentControls.Add(wdContentControlText, oRng)
With oCC
.Title = "P.O.Number"
.Tag = "P.O.Number"
End With
Exit Do
Loop
End With

Set oTable = oDoc.Tables(1)
Set oCell = oTable.Cell(2, 2).Range
oCell.End = oCell.End - 1
Set oCC = oDoc.ContentControls.Add(wdContentControlDate, oCell)
With oCC
.Title = "Date"
.Tag = "Date"
End With

Set oTable = oDoc.Tables(2)
Set oCell = oTable.Cell(1, 1).Range
oCell.End = oCell.End - 1
With oCell.Find
Do While .Execute(FindText:="Requisition#" & Chr(9))
oCell.Collapse 0
oCell.MoveEndUntil Chr(13)
Set oCC = oDoc.ContentControls.Add(wdContentControlText, oCell)
With oCC
.Title = "Requisition Number"
.Tag = "Requisition Number"
End With
Exit Do
Loop
End With

Set oTable = oDoc.Tables(4)
Set oCell = oTable.Cell(1, 1).Range
oCell.End = oCell.End - 1
Set oCC = oDoc.ContentControls.Add(wdContentControlText, oCell)
With oCC
.Title = "Data"
.Tag = "Data"
End With
Set oCell = oTable.Cell(1, 5).Range
oCell.End = oCell.End - 1
Set oCC = oDoc.ContentControls.Add(wdContentControlText, oCell)
With oCC
.Title = "Amount"
.Tag = "Amount"
End With
lbl_Exit:
Set oCell = Nothing
Set oRng = Nothing
Set oTable = Nothing
Set oDoc = Nothing
Exit Sub
End Sub

[NaRa]

Thank you so much for all of your help sir! I wondered if approaching the document more from a table standpoint would be more efficient. If I open a document with no CC and F8 through the code it will add CC to all of the fields I need, but if I run the macro it errors on the date section with "This method or property is not available because the current selection partially covers a plain text content control." . Could this be an issue related to spacing of the tables? Thank you again for all of your help! I am almost there and you have given me a massive amount of education <3

EDIT****After playing with the script for a little bit I can get it to add the CC if I F8 through the script, it will occasionally error on either the Date or Data lines, the error around the data lines reads "Plain text controls cannot be inserted around multiple paragraphs". Have found one wrench with the documents, in some of them the 2nd table is split up into multiple cells like the example below; will work on adding another section to the req number to see if it can search to see if it is in the 1st cell OR (what I assume is) Req# in cell (2, 1) and the value is in cell (2, 2). Other than that this is absolutely amazing I cannot thank you enough and can't wait until I have half the understand you and a lot of other users on this site have! This is just as much fun as it is frustrating ^_^


16751


Will keep plugging away and see what I can do, have a great day!

[gmayor]

In the case of the error message, that should be easily fixed by clearing the ranges (Range.Text = "") before adding the content control e.g. change the AddControls macro for the following:

Sub AddControls(oDoc As Document)
Dim oTable As Table
Dim oCell As Range
Dim oRng As Range
Dim oCC As ContentControl
Set oRng = oDoc.Range
With oRng.Find
Do While .Execute(FindText:="PO Number - ")
oRng.Collapse 0
oRng.MoveEndUntil Chr(13)
oRng.Text = ""
Set oCC = oDoc.ContentControls.Add(wdContentControlText, oRng)
With oCC
.Title = "P.O.Number"
.Tag = "P.O.Number"
End With
Exit Do
Loop
End With

Set oTable = oDoc.Tables(1)
Set oCell = oTable.Cell(2, 2).Range
oCell.End = oCell.End - 1
oCell.Text = ""
Set oCC = oDoc.ContentControls.Add(wdContentControlDate, oCell)
With oCC
.Title = "Date"
.Tag = "Date"
End With

Set oTable = oDoc.Tables(2)
Set oCell = oTable.Cell(1, 1).Range
oCell.End = oCell.End - 1
With oCell.Find
Do While .Execute(FindText:="Requisition#" & Chr(9))
oCell.Collapse 0
oCell.MoveEndUntil Chr(13)
oCell.Text = ""
Set oCC = oDoc.ContentControls.Add(wdContentControlText, oCell)
With oCC
.Title = "Requisition Number"
.Tag = "Requisition Number"
End With
Exit Do
Loop
End With

Set oTable = oDoc.Tables(4)
Set oCell = oTable.Cell(1, 1).Range
oCell.End = oCell.End - 1
oCell.Text = ""
Set oCC = oDoc.ContentControls.Add(wdContentControlText, oCell)
With oCC
.Title = "Data"
.Tag = "Data"
End With
Set oCell = oTable.Cell(1, 5).Range
oCell.End = oCell.End - 1
oCell.Text = ""
Set oCC = oDoc.ContentControls.Add(wdContentControlText, oCell)
With oCC
.Title = "Amount"
.Tag = "Amount"
End With
lbl_Exit:
Set oCell = Nothing
Set oRng = Nothing
Set oTable = Nothing
Set oDoc = Nothing
Exit Sub
End Sub

[gmaxey]

I would think that preserving existing data is important. Yes?

How about substituting this:


Set oTable = oDoc.Tables(4)
Set oCell = oTable.Cell(1, 1).Range
oCell.End = oCell.End - 1
oCell.Text = ""
Set oCC = oDoc.ContentControls.Add(wdContentControlText, oCell)
With oCC
.Title = "Data"
.Tag = "Data"
End With


with this:


Set oRng = oDoc.Tables(4).Cell(1, 1).Range
oRng.End = oRng.End - 1
If oRng.Paragraphs.Count > 1 Then
oRng.Text = Replace(oRng.Text, Chr(13), "~!~")
Set oCC = oDoc.ContentControls.Add(wdContentControlText, oRng)
oCC.MultiLine = True
oRng.Text = Replace(oRng.Text, "~!~", Chr(13))
Else
oDoc.ContentControls.Add wdContentControlText, oRng
End If
oCC.Title = "Data"

[gmaxey]

Does the requisition number always follow the pattern "N[0-9]{9}"? Perhaps you could find and process it directly.

[NaRa]

I would think that preserving existing data is important. Yes?

How about substituting this:


Set oTable = oDoc.Tables(4)
Set oCell = oTable.Cell(1, 1).Range
oCell.End = oCell.End - 1
oCell.Text = ""
Set oCC = oDoc.ContentControls.Add(wdContentControlText, oCell)
With oCC
.Title = "Data"
.Tag = "Data"
End With


with this:


Set oRng = oDoc.Tables(4).Cell(1, 1).Range
oRng.End = oRng.End - 1
If oRng.Paragraphs.Count > 1 Then
oRng.Text = Replace(oRng.Text, Chr(13), "~!~")
Set oCC = oDoc.ContentControls.Add(wdContentControlText, oRng)
oCC.MultiLine = True
oRng.Text = Replace(oRng.Text, "~!~", Chr(13))
Else
oDoc.ContentControls.Add wdContentControlText, oRng
End If
oCC.Title = "Data"


Absolutely yes I do need to preserve the data so that I can run my next macro that pulls the content controls from these files into a spreadsheet in excel.


Does the requisition number always follow the pattern "N[0-9]{9}"? Perhaps you could find and process it directly.

Yes sir; it always follows this pattern.

After playing with the script and adding in your portion gmaxey I am able to run through the script without issue until I get to the " myDoc.Close SaveChanges:=True" and keep getting a Run Time error 91 .... Not sure why since "myDoc" was already set with Dim myDoc As Word.Document..

Current code reads


Option Explicit

Sub ContentControls()
Dim myDoc As Word.Document
Dim MyFolder As String, StrFile As String
Dim fso As Object

MyFolder = "C:\Users\mesmith\Desktop\SQL Practice\Demo\"
Application.ScreenUpdating = False
Set fso = CreateObject("Scripting.FileSystemObject")
If Not (fso.FolderExists(MyFolder)) Then
MsgBox "The named folder does not exist"
Set fso = Nothing
Exit Sub
End If
StrFile = Dir(MyFolder & "\*.docx", vbNormal)

While StrFile <> ""
Set myDoc = Documents.Open(FileName:=MyFolder & "\" & StrFile, Visible:=False)
If myDoc.ContentControls.Count = 0 And _
myDoc.Tables.Count = 4 Then
AddControls myDoc
End If
myDoc.Close SaveChanges:=True
StrFile = Dir()
Wend
lbl_Exit:
Set myDoc = Nothing
Set fso = Nothing
Exit Sub
End Sub

Sub AddControls(oDoc As Document)
Dim oTable As Table
Dim oCell As Range
Dim oRng As Range
Dim oCC As ContentControl
Set oRng = oDoc.Range
With oRng.Find
Do While .Execute(FindText:="PO Number - ")
oRng.Collapse 0
oRng.MoveEndUntil Chr(13)
Set oCC = oDoc.ContentControls.Add(wdContentControlText, oRng)
With oCC
.Title = "P.O.Number"
.Tag = "P.O.Number"
End With
Exit Do
Loop
End With

Set oTable = oDoc.Tables(1)
Set oCell = oTable.Cell(2, 2).Range
oCell.End = oCell.End - 1
Set oCC = oDoc.ContentControls.Add(wdContentControlDate, oCell)
With oCC
.Title = "Date"
.Tag = "Date"
End With

Set oTable = oDoc.Tables(2)
Set oCell = oTable.Cell(1, 1).Range
oCell.End = oCell.End - 1
With oCell.Find
Do While .Execute(FindText:="Requisition#" & Chr(9))
oCell.Collapse 0
oCell.MoveEndUntil Chr(13)
Set oCC = oDoc.ContentControls.Add(wdContentControlText, oCell)
With oCC
.Title = "Requisition Number"
.Tag = "Requisition Number"
End With
Exit Do
Loop
End With

Set oRng = oDoc.Tables(4).Cell(1, 1).Range
oRng.End = oRng.End - 1
If oRng.Paragraphs.Count > 1 Then
oRng.Text = Replace(oRng.Text, Chr(13), "~!~")
Set oCC = oDoc.ContentControls.Add(wdContentControlText, oRng)
oCC.MultiLine = True
oRng.Text = Replace(oRng.Text, "~!~", Chr(13))
Else
oDoc.ContentControls.Add wdContentControlText, oRng
End If
With oCC
.Title = "Data"
.Tag = "Data"
End With
Set oTable = oDoc.Tables(4)
Set oCell = oTable.Cell(1, 5).Range
oCell.End = oCell.End - 1
Set oCC = oDoc.ContentControls.Add(wdContentControlText, oCell)
With oCC
.Title = "Amount"
.Tag = "Amount"
End With
lbl_Exit:
Set oCell = Nothing
Set oRng = Nothing
Set oTable = Nothing
Set oDoc = Nothing
Exit Sub
End Sub

[gmaxey]

Use:

myDoc.Close wdSaveChanges

In the case of the actual req# appearing in an adjacent cell, you could search directly for "N[0-9]{9}" using wildcards.

[NaRa]

Use:

myDoc.Close wdSaveChanges

In the case of the actual req# appearing in an adjacent cell, you could search directly for "N[0-9]{9}" using wildcards.


Thank you for the suggestion on the Req number I will work on adding that in today; especially once this save business is taken care of. I have tried using the "wdSaveChanges" "wdSaveChanges:=True" and "myDoc.Close([SaveChanges])" . All of which still give the same error of not having the variable set. Really scratching my head on this one. To me it appears everything is correct (which I know doesn't mean much with a grand total of two weeks of VBA under my belt).

**Edit: The error seems to come from when a file has content controls added to it and actually needs to be saved. There are 9 documents in the folder and if all of them have CC added there is no issue when running the macro. However if I remove the CC controls from one of the files the macro stops on that file. I have to open the file > close > save and the content controls are exactly where they should be. As silly as it sounds would it be easier to use SaveAs then save the file to another folder with the same file name? It seems silly but if it works I'm not opposed to it.

[gmaxey]

No, the issue is that you are setting oDoc = Nothing in the sub-routine. Remove Set oDoc = Nothing there.

[NaRa]

No, the issue is that you are setting oDoc = Nothing in the sub-routine. Remove Set oDoc = Nothing there.

.... You just made it seem so easy...

Thank you BOTH Gmaxey and Gmayor !!! You are amazing! I will mark this as solved and start working on searching for the Req # with the wildcards. Thank you both very much for all of the help / education!

[gmaxey]

Almost anything is easy when you know how. Now you do!