Problems searching a directory of word files

[Desmondo]

I am really new to VBA and have taken it upon myself to try and improve a routine that we have at work.

We have 16 categories of cases each category has its own sub folder with a set of relevant word templates either 1 or 2. We also have a generic folder which holds two letters that we send out to all but adapt the wording slightly and details. In addition we also send an excel user form by email to another dept to inform them what is happening. I am trying to streamline the process a bit as 95% of the information is replicated for each customer on each document. I have looked at mail merge but this didn't seem practical.

So i have started to build a solution, what i have is a user form which has 16 category buttons on it for each type of case, the button launches a sub form where the required information for each template is input so as to be eventually transmitted by a macro to each word doc and then email form.

What i have so far managed to achieve is the opening of a single file in the directory but cannot open anymore. I suspect i need to write some sort of loop to go through the sub directory to apply info/Print/Save the files ideally all in there own unique folder but any methods or tutorials i have found so far are going above my head. I am fairly certain i will get the bookmarking of the files in the next stage fine so i think this is my main stumbling block so any help and patience would be welcome. I have literally just started learning VBA a week ago.

My code so far

Private Sub CommandButton2_Click()
'Declare obj variables for the word application and document.
Dim WdApp As Object, wddoc As Object
'Declare a String variable for the example document's name and folder path.
Dim strDocName As String
'On Error statement if Word is not already open.
On Error Resume Next
'Activate Word if it is already open.
Set WdApp = GetObject(, "Word.Application")
If Err.Number = 429 Then
Err.Clear
'Create a Word application if Word is not already open.
Set WdApp = CreateObject("Word.Application")
End If
'Make sure the Word application is visible.
WdApp.Visible = True
'Define the strDocName String variable.
strDocName = "C:\Users\desmo\Desktop\wdtest\myNewWordDoc.docx"
'Check the directory for the presence of the document
'name in the folder path.
'If it is not recognized, inform the user and exit the macro.
If Dir(strDocName) = "" Then
MsgBox "The file myWordDoc.docx" & vbCrLf & _
"was not found in the folder path" & vbCrLf & _
"C:\Your\File\Path\.", _
vbExclamation, _
"Sorry, that document name does not exist."
Exit Sub
End If
'Activate the Word application.
WdApp.Activate
'Set the Object variable for the Word document's full name and folder path.
Set wddoc = WdApp.Documents(strDocName)
'If the Word document is not already open, then open it.
If wddoc Is Nothing Then Set wddoc = WdApp.Documents.Open(strDocName)
'The document is open, so activate it.
wddoc.Activate
'Release system memory that was reserved for the two Object variables.
Set wddoc = Nothing
Set WdApp = Nothing
End Sub

[mdmackillop]

Dim WdApp As Object




Private Sub CommandButton2_Click()
Dim i As Long
Dim Pth As String, fType As String
Dim Arr
fType = """C:\VBAX\*.doc*"""
Pth = "C:\VBAX\"


Arr = Filter(Split(CreateObject("wscript.shell").exec("cmd /c Dir " & fType & " /b /a-d").stdout.readall, vbCrLf), ".")
On Error Resume Next
Set WdApp = GetObject(, "Word.Application")
If Err.Number = 429 Then
Err.Clear
'Create a Word application if Word is not already open.
Set WdApp = CreateObject("Word.Application")
End If
On Error GoTo 0
WdApp.Visible = True


For i = LBound(Arr) To UBound(Arr)
Call DoStuff(Pth & Arr(i))
Next i

WdApp.Quit
Set WdApp = Nothing


End Sub






Private Sub DoStuff(strDocName As Variant)
'Declare obj variables for the word application and document.
Dim wddoc As Object
'On Error statement if Word is not already open.
On Error Resume Next
'Activate Word if it is already open.
'Define the strDocName String variable.
'Activate the Word application.
WdApp.Activate
'Set the Object variable for the Word document's full name and folder path.
Set wddoc = WdApp.Documents(strDocName)
'If the Word document is not already open, then open it.
If wddoc Is Nothing Then Set wddoc = WdApp.Documents.Open(strDocName)
'The document is open, so activate it.
wddoc.Activate
'Do things to Word Document here




'Close and Save changes
wddoc.Close True
'Release system memory that was reserved for the two Object variables.
Set wddoc = Nothing
End Sub

[Desmondo]

Thanks Mdmackillop this has been a great help, I have implimented your code and seems to be looping through the directory. Not fully understanding the code yet.

Understand that you have used shell to list the dir for looping through and thanks for the hint 'Do things to Word Document here comment. So that i know where to start with the rest of the app which is just really bookmarks for each of the templates. What i wanted to check was where i have put the file path is it possible to put more than 1 as there are is a generic folder with some docs that apply to all cases. If so how would i show that.

Also where would you recommend i learn stuff like your code as it way more advanced than any of the books i am reading?

[mdmackillop]

You can list the paths in an array as here or refer to a range in the workbook where they are listed.
For more on the Shell method, refer to SNB's site (http://www.snb-vba.eu/index_en.html)


Private Sub CommandButton2_Click()
Dim i As Long
Dim Pth As String, fType As String
Dim Arr
Dim ListOfFolders

On Error Resume Next
Set WdApp = GetObject(, "Word.Application")
If Err.Number = 429 Then
Err.Clear
Set WdApp = CreateObject("Word.Application")
End If
On Error GoTo 0
WdApp.Visible = True

ListOfFolders = Array("C:\VBAX\", "C:\Fld2\", "C:\Fld3\")
For Each f In ListOfFolders
fType = f & "* .doc * "
Pth = f

Arr = Filter(Split(CreateObject("wscript.shell").exec("cmd /c Dir " & fType & " /b /a-d").stdout.readall, vbCrLf), ".")

For i = LBound(Arr) To UBound(Arr)
'debug.Print Pth & Arr(i)
Call DoStuff(Pth & Arr(i))
Next i
Next f

WdApp.Quit
Set WdApp = Nothing
End Sub