Consulting

Results 1 to 4 of 4

Thread: MS Word vba SaveAs2 giving File Permission error

  1. #1
    VBAX Newbie
    Joined
    Oct 2018
    Posts
    2
    Location

    MS Word vba SaveAs2 giving File Permission error

    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

  2. #2
    VBAX Sage
    Joined
    Apr 2007
    Location
    United States
    Posts
    8,711
    Location
    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
    ---------------------------------------------------------------------------------------------------------------------

    Paul


    Remember: Tell us WHAT you want to do, not HOW you think you want to do it

    1. Use [CODE] ....[/CODE ] Tags for readability
    [CODE]PasteYourCodeHere[/CODE ] -- (or paste your code, select it, click [#] button)
    2. Upload an example
    Go Advanced / Attachments - Manage Attachments / Add Files / Select Files / Select the file(s) / Upload Files / Done
    3. Mark the thread as [Solved] when you have an answer
    Thread Tools (on the top right corner, above the first message)
    4. Read the Forum FAQ, especially the part about cross-posting in other forums
    http://www.vbaexpress.com/forum/faq...._new_faq_item3

  3. #3
    VBAX Newbie
    Joined
    Oct 2018
    Posts
    2
    Location
    Quote Originally Posted by Paul_Hossler View Post
    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.

  4. #4
    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
    Graham Mayor - MS MVP (Word) 2002-2019
    Visit my web site for more programming tips and ready made processes
    http://www.gmayor.com

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •