MS Word vba SaveAs2 giving File Permission error

[mallen]

I am trying to save a word document, after making automated changes, to a different folder and with a different name.
I am finding the file path of the original document, saving it in a sub-folder "Student Reports" and then giving the new document a name taken from a table within the original document.
If I use the code below I get the error: Unable to save .... File permission error....Run time error 5487.
If I change the 4th and 5th lines and set the StuName to "Test" then it saves correctly.
There would appear to be a problem with the variable obtained from the ActiveDocument.Table, but I can't seem to solve the problem.
The message box line is to check that the created filepath is correct - which it is.
I'm using Office 2010 and Windows 7.
Can anybody help please?

The code I using is:

Filepath = ThisDocument.FullName
FileOnly = ThisDocument.Name
PathOnly = Left(Filepath, Len(Filepath) - Len(FileOnly))


StuName = ActiveDocument.Tables(1).Cell(4, 2)
' StuName = "Test"

StuPath = PathOnly & "Student Reports" & StuName
strfilename = StuPath
' MsgBox StuPath
ActiveDocument.SaveAs FileName:=strfilename

[Paul_Hossler]

Try





StuName = Left(ActiveDocument.Tables(1).Cell(4, 2), Len(
ActiveDocument.Tables(1).Cell(4, 2))-2)




A throwaway macro shows there are 2 'table-related' characters in the Value




Option Explicit

Sub test()

Dim s As Variant

s = ActiveDocument.Tables(1).Cell(1, 1)
MsgBox "#" & s & "#"

s = "#" & Left(s, Len(s) - 2) & "#"
MsgBox s

End Sub

[mallen]

Try





StuName = Left(ActiveDocument.Tables(1).Cell(4, 2), Len(
ActiveDocument.Tables(1).Cell(4, 2))-2)




A throwaway macro shows there are 2 'table-related' characters in the Value




Option Explicit

Sub test()

Dim s As Variant

s = ActiveDocument.Tables(1).Cell(1, 1)
MsgBox "#" & s & "#"

s = "#" & Left(s, Len(s) - 2) & "#"
MsgBox s

End Sub






Thank you so much. I had tried Length -1 but didn't think to try -2.
What an idiot!!
Now works perfectly.

[gmayor]

To clarify what Paul has suggested I have expanded the code with explanations


Sub MySave()
Dim FilePath As String, strFilename As String
Dim oCell As Range
FilePath = ThisDocument.path & "\" 'The path of the document or template containing this macro
FilePath = FilePath & "Student Reports" 'add the subfolder to store the document
Set oCell = ActiveDocument.Tables(1).Cell(4, 2).Range 'the cell range that contains the filename
oCell.End = oCell.End - 1 'remove the cell end character from the range
strFilename = Trim(oCell.Text) 'Remove any unwanted spaces from the start and end of the name
MsgBox FilePath & strFilename & ".docx" 'for testing before including the next two lines
'CreateFolders FilePath 'ensure the subfolder exists
'ActiveDocument.SaveAs2 _
FileName:=FilePath & strFilename & ".docx", _
FileFormat:=12 'save the document as wdFormatXMLDocument
Set oCell = Nothing
End Sub

Private Function CreateFolders(strPath As String)
'Graham Mayor - http://www.gmayor.com - Last updated - 31 May 2017
'Creates the full path 'strPath' if missing or incomplete
Dim strTempPath As String
Dim lng_Path As Long
Dim VPath As Variant
Dim oFSO As Object
Dim i As Integer
Set oFSO = CreateObject("Scripting.FileSystemObject")
VPath = Split(strPath, "\")
If Left(strPath, 2) = "\\" Then
strPath = "\\" & VPath(2) & "\"
For lng_Path = 3 To UBound(VPath)
strPath = strPath & VPath(lng_Path) & "\"
If Not oFSO.FolderExists(strPath) Then MkDir strPath
Next lng_Path
Else
strPath = VPath(0) & "\"
For lng_Path = 1 To UBound(VPath)
strPath = strPath & VPath(lng_Path) & "\"
If Not oFSO.FolderExists(strPath) Then MkDir strPath
Next lng_Path
End If
lbl_Exit:
Set oFSO = Nothing
Exit Function
End Function