Problems saving a created word doc copy to created directory

[Desmondo]

This is going to be a hard one to explain, I have been writing some code to do a task that i have to repeat regularly at work.

I have created a userform and populated a word.doc with bookmarks on the click of a submit / save button I want to be able to create a copy of the doc in a folder that is created with a dynamic path i have just created.

The main folder is a static but sub folders are appended with customer surname and reference so on the end i have a folder called archive and within that lots of folders with customer name and ref.

I am able to create the doc and the folder no problem. But cannot get the doc to save in the folder. I am calling the save function to make a copy using a variable i created earlier in the procedure called strFolder . The word dialogue box opens to save as but I want it just to make a copy and open directory without all the alerts.

Hope someone can help.

wdDoc.SaveAs "C:\strFolder" & "OP.docx"

I am totally new to vba so there may well be other areas that are incorrect or could organised better. Hope someone can point out the error of my ways.

Private Sub CommandButton1_Click()
Const strParent = "C:\Users\desmo\Desktop\directory\OPTool 191017\Archive"
Dim strSurname As String
Dim strNino As String
Dim strFolder As String
Dim strFolderValue As String
Dim fso As Object
'Get ID from control
strSurname = Me.Surname
' Get ID from from control
strNino = Me.Nino
' Full path
strFolderValue = strSurname & " " & strNino
strFolder = strParent & " " & strFolderValue
' Create FileSystemObject
Set fso = CreateObject("Scripting.FileSystemObject")
' Check whether folder exists
If fso.FolderExists(strFolder) = False Then
fso.CreateFolder strFolder
MsgBox "Creating Directory"
Else

MsgBox "Folder Already Exists here"


End If



'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.
Dim Partner As String
Dim Clmt As String
Dim Couple As String
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\directory\OPTool 191017\op.doc"
'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 OP" & vbCrLf & _
"was not found in the folder path" & vbCrLf & _
"C:\Users\desmo\Desktop\directory\OPTool 191017\op.", _
vbExclamation, _
"Sorry, that document name does not exist."
End If
'Create the Word document from the template.
Set wdDoc = WdApp.Documents.Add(strDocName)


Clmt = ComboBox1.Value & " " & Surname.Value & " "
Partner = "&" & " " & ComboBox2.Value & " " & PSurname.Value
Couple = Clmt & " " & Partner


With wdDoc

.Bookmarks("Title").Range.Text = ComboBox1.Value
.Bookmarks("Forename").Range.Text = Forename.Value
.Bookmarks("Surname").Range.Text = Surname.Value
.Bookmarks("Nino").Range.Text = Nino.Value
'.Bookmarks("doc").Range.Text = claimDate.Value
'.Bookmarks("apStart").Range.Text = apStart.Value
'.Bookmarks("apEnd").Range.Text = apEnd.Value
.Bookmarks("iPyt").Range.Text = IPyt.Value
.Bookmarks("Title1").Range.Text = ComboBox1.Value
'.Bookmarks("iDate").Range.Text = iDate.Value
.Bookmarks("CPyt").Range.Text = cPyt.Value
'.Bookmarks("CPytDate").Range.Text = cPytDate.Value
'.Bookmarks("iDate1").Range.Text = iDate.Value
.Bookmarks("iPyt1").Range.Text = IPyt.Value
.Bookmarks("Title2").Range.Text = ComboBox1.Value
.Bookmarks("Surname1").Range.Text = Surname.Value
.Bookmarks("Surname2").Range.Text = Surname.Value
'.Bookmarks("apStart1").Range.Text = apStart.Value
'.Bookmarks("apEnd1").Range.Text = apEnd.Value
.Bookmarks("iPyt2").Range.Text = IPyt.Value
.Bookmarks("Title3").Range.Text = ComboBox1.Value
.Bookmarks("Surname3").Range.Text = Surname.Value
.Bookmarks("AddressL1").Range.Text = AddressL1.Value
.Bookmarks("AddressL2").Range.Text = AddressL2.Value
.Bookmarks("City").Range.Text = City.Value
.Bookmarks("PCode").Range.Text = Pcode.Value
.Bookmarks("PTitle").Range.Text = ComboBox2.Value
.Bookmarks("PForename").Range.Text = PForename.Value
.Bookmarks("PSurname").Range.Text = PSurname.Value
.Bookmarks("PNino").Range.Text = PNino.Value
.Bookmarks("PTitle1").Range.Text = ComboBox2.Value
.Bookmarks("PForename1").Range.Text = PForename.Value
.Bookmarks("PSurname1").Range.Text = PSurname.Value


If CheckBox1.Value = True Then
.Bookmarks("Clmts").Range.Text = Couple
Else
.Bookmarks("Clmts").Range.Text = Clmt


End If

WdApp.DisplayAlerts = False

wdDoc.Save
'copies the active document- the ActiveDocument.FullName is important otherwise it will just create a blank document
WdApp.Documents.Add ActiveDocument.FullName
'the next line saves the copy to your location and name
wdDoc.SaveAs "C:\strFolder" & "OP.docx"
'next line closes the copy leaving you with the original document
wdDoc.Close

End With

'Open created directory
Shell "explorer.exe " & strFolder, vbNormalFocus


'Release system memory that was reserved for the two Object variables.
Set wdDoc = Nothing
Set WdApp = Nothing

 

[Norie]

Since strFolder is a variable it shouldn't be in quotes, try this.

wdDoc.SaveAs "C:\" & strFolder & "\OP.docx"

PS You might want to a look in the root directory of the C:\ drive.

 

[Desmondo]

Since strFolder is a variable it shouldn't be in quotes, try this.

wdDoc.SaveAs "C:\" & strFolder & "\OP.docx"

PS You might want to a look in the root directory of the C:\ drive.

Hi Norrie and thanks for the very quick reply, i have amended the code but still same outcome.

 

[Norie]

Are you getting any error messages?

Is the document being saved but in the wrong location?

What is the value of strFolder?

 

[Desmondo]

Hi No error messages and the strDoc should = what was created by the fso command. Which is the constant path "C:\Users\desmo\Desktop\directory\OPTool 191017\Archive" + variable strFolder which is the value of Surname and reference based on user input on a userform. I am getting two dialogue boxes as me to where is want to save and bizarrely 2 docs one called part1.doc which i didn't even create.

Windows brings up my docs for the part1.docx file & then the same box with the same options?

 

[Norie]

You might be getting the two dialogs because you are saving twice, first here.

wdDoc.Save

and then here.

wdDoc.SaveAs "C:\strFolder" & "OP.docx"

PS Why don't you use a template document?

 

[Desmondo]

I thought that's what i was doing, didn't think it really mattered if docx or dotx?

 

[Norie]

If you use a template document (dotx) a brand new document is created based on the original, if you use a 'standard' document (docx) then you are creating a copy of the original which isn't the same.

I would use a template to create a new document right at the start rather than opening an existing document, populating it and then copying it which is what your code appears to do.

 

[Desmondo]

Cheers i think I will give that a go and while I am there put the mkdir in a separate sub and just call it when needed. Will probably need to do the check for the new directory again I think as doesn't seem to like the variable strDoc just thought I would save myself some time. Probably makes sense as g need to do the same for a few other docs I will be doing the same for. Thanks for your help

 

[Desmondo]

Managed to get this working eventually tonight and working very well, i had to rejig the placement of my code and as you said create a word template. Very happy with the outcome and the pace in which it carries out the sub added a few more pieces of code to the code the fill a variable bookmark on whether or not the client had a partner or not. I am now looking to apply the same sub to other docs that i have that will use the same information and carry out the same process. Not sure if that's a loop of some kind i need or if i can activate more than one template from file. Her is my code if anyone is interested -

Private Sub CommandButton1_Click()
'=====================================================================================================================
'Checks for and Creates a Directory and saves copy of template correctly
'=====================================================================================================================


Call MKDir


'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.
Const strParent = "C:\Users\desmo\Desktop\latest\Archive"
Dim strFolderName As String
Dim strSurname As String
Dim strNino As String
Dim strFilePath As String
Dim Partner As String
Dim Clmt As String
Dim Couple As String


'Get Surname from control
strSurname = Me.Surname
' Get nino from from control
strNino = Me.Nino


strFolderName = strSurname & " " & strNino
'MsgBox strFolderName
strFilePath = strParent & strFolderName & ""
MsgBox " Creating your files in " & strFilePath


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 = "\\DFZ70406.link2.gpn.gov.uk\70805003$\OPTool 191017\op.dotx"
strDocName = "C:\Users\desmo\Desktop\latest\op.dotx"
'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 OP" & vbCrLf & _
"was not found in the folder path" & vbCrLf & _
"\\DFZ70406.link2.gpn.gov.uk\70805003$\OPTool 191017\op.", _
vbExclamation, _
"Sorry, that document name does not exist."
End If


'Create the Word document from the template.
Set wdDoc = wdApp.Documents.Add(strDocName)

'Variable values to determine if couple or not for decision completion

Clmt = ComboBox1.Value & " " & Surname.Value
Partner = " " & ComboBox2.Value & " " & PSurname.Value
Couple = Clmt & " " & Partner




With wdDoc
.Bookmarks("Title").Range.Text = ComboBox1.Value
.Bookmarks("Forename").Range.Text = Forename.Value
.Bookmarks("Surname").Range.Text = Surname.Value
.Bookmarks("Nino").Range.Text = Nino.Value
.Bookmarks("doc").Range.Text = claimDate.Value
.Bookmarks("apStart").Range.Text = apStart.Value
.Bookmarks("apEnd").Range.Text = apEnd.Value
.Bookmarks("iPyt").Range.Text = IPyt.Value
.Bookmarks("Title1").Range.Text = ComboBox1.Value
.Bookmarks("iDate").Range.Text = iDate.Value
.Bookmarks("CPyt").Range.Text = cPyt.Value
.Bookmarks("CPytDate").Range.Text = cPytDate.Value
.Bookmarks("iDate1").Range.Text = iDate.Value
.Bookmarks("iPyt1").Range.Text = IPyt.Value
.Bookmarks("Title2").Range.Text = ComboBox1.Value
.Bookmarks("Surname1").Range.Text = Surname.Value
.Bookmarks("Surname2").Range.Text = Surname.Value
.Bookmarks("apStart1").Range.Text = apStart.Value
.Bookmarks("apEnd1").Range.Text = apEnd.Value
.Bookmarks("iPyt2").Range.Text = IPyt.Value
.Bookmarks("Title3").Range.Text = ComboBox1.Value
.Bookmarks("Surname3").Range.Text = Surname.Value
.Bookmarks("AddressL1").Range.Text = AddressL1.Value
.Bookmarks("AddressL2").Range.Text = AddressL2.Value
.Bookmarks("City").Range.Text = City.Value
.Bookmarks("PCode").Range.Text = Pcode.Value
.Bookmarks("PTitle").Range.Text = ComboBox2.Value
.Bookmarks("PForename").Range.Text = PForename.Value
.Bookmarks("PSurname").Range.Text = PSurname.Value
.Bookmarks("PNino").Range.Text = PNino.Value
.Bookmarks("PTitle1").Range.Text = ComboBox2.Value
.Bookmarks("PForename1").Range.Text = PForename.Value
.Bookmarks("PSurname1").Range.Text = PSurname.Value

If CheckBox1.Value = True Then
.Bookmarks("Clmts").Range.Text = Couple
Else
.Bookmarks("Clmts").Range.Text = Clmt
End If

End With



wdDoc.SaveAs strFilePath & "op.doc"
wdDoc.Close True





'Release system memory that was reserved for the two Object variables.
Set wdDoc = Nothing
Set wdApp = Nothing
'Close Word Doc
Call CloseWordDocuments
'Open created Folder
Shell "explorer.exe " & strFilePath, vbNormalFocus








End Sub