Word VBA: SaveAs2

tinfanide · #1 04-14-2012, 07:43 AM

Run-time Error (5487)
word cannot complete the save due to a file permission error

Code:

Dim str1 As String, str2 As String

With ActiveDocument
    .Select
    With Selection
        .Find.ClearFormatting
        .Find.Execute FindText:="The Principal", MatchWholeWord:=True
        .HomeKey
        .MoveDown
        .EndKey Unit:=wdLine
        .MoveLeft Unit:=wdCharacter, Count:=1
        .HomeKey Unit:=wdLine, Extend:=wdExtend
        str1 = Trim(Selection.Range.Text)
    End With
    .Select
    With Selection
        .Find.Execute FindText:="RE: ", MatchWholeWord:=True
        .MoveRight Unit:=wdCharacter, Count:=1
        .EndKey Unit:=wdLine, Extend:=wdExtend
        str2 = Trim(Selection.Range.Text)
    End With
    .SaveAs2 FileName:=ThisDocument.Path & "\" & str1 & " " & str2, FileFormat:=wdFormatDocumentDefault
End With

Please see the attachment.
I don't know why str2 causes the problem to saving the document.
14 April 2012.docx

Many thanks in advance.

macropod · #2 04-15-2012, 02:38 AM

Hi tinfanide,

Try something along the lines of:

Code:

Dim Rng As Range, Str1 As String, Str2 As String
With ThisDocument
  With .Content
    With .Find
      .ClearFormatting
      .MatchWildcards = True
      .Text = "The Principal^13[!13]@^13"
      .Execute
    End With
    If .Find.Found Then
      Set Rng = .Duplicate.Paragraphs.Last
      With Rng
        .End = .End - 1
        Str1 = Trim(.Text)
      End With
    End If
    With .Find
      .Text = "RE: [!13]@^13"
      .Execute
    End With
    If .Find.Found Then
      Set Rng = .Duplicate.Paragraphs.Last
      With Rng
        .End = .End - 1
        .Start = .Start + 4
        Str2 = Trim(.Text)
      End With
    End With
    .SaveAs2 FileName:=.Path & "\" & Str1 & " " & Str2, FileFormat:=wdFormatDocumentDefault
End With

tinfanide · #3 04-16-2012, 07:36 AM

Paul, thanks for your codes.
I've amended them a bit according to the errors reported.

Code:

Dim Rng As Range, Str1 As String, Str2 As String
With ThisDocument
  With .Content
        With .Find
          .ClearFormatting
          .MatchWildcards = True
          .Text = "The Principal"
          .Execute
        End With
        If .Find.Found Then
          Set Rng = .Duplicate.Paragraphs.Last.Range
          With Rng
            .End = .End - 2
            Str1 = Trim(.Text)
          End With
        End If
        With .Find
          .Text = "R"
          .Execute
        End With
        If .Find.Found Then
          Set Rng = .Duplicate.Paragraphs.Last.Range
          With Rng
            .End = .End - 1
            .Start = .Start + 4
            Str2 = Trim(.Text)
          End With
        End If
    End With
    .SaveAs2 FileName:=.Path & "\" & Str1 & " " & Str2, FileFormat:=wdFormatDocumentDefault
End With

But stange things happen then.
Either string can be found, not both.
When I move Str2 in front of Str1,
Str1 cannot be found and
vice versa.

Could ya tell me why?

macropod · #4 04-16-2012, 03:26 PM

Is there a reason you changed the Find strings? Your's won't do the same as mine.

tinfanide · #5 04-17-2012, 06:32 AM

Quote:

Originally Posted by macropod

Is there a reason you changed the Find strings? Your's won't do the same as mine.

Code:

Sub test()

Dim Rng As Range, Str1 As String, Str2 As String
With ThisDocument
  With .Content
    With .Find
      .ClearFormatting
      .MatchWildcards = True
      .Text = "The Principal^13[!13]@^13" ''' the wildcards return .Find.Found = false
      .Execute
    End With
    If .Find.Found Then
      Set Rng = .Duplicate.Paragraphs.Last '''.Range
      With Rng
        .End = .End - 1 ''' should be -2 (-1 the comma still exists)
        Str1 = Trim(.Text)
      End With
    End If
    With .Find
      .Text = "RE: [!13]@^13" ''' the wildcards return .Find.Found = false
      .Execute
    End With
    
    If .Find.Found Then
      Set Rng = .Duplicate.Paragraphs.Last '''.Range
      With Rng
        .End = .End - 1
        .Start = .Start + 4
        Str2 = Trim(.Text)
      End With

''' End If
''' missed in the original codes
    End If
    End With
    
    .SaveAs2 FileName:=.Path & "\" & Str1 & " " & Str2, FileFormat:=wdFormatDocumentDefault
    
End With

End Sub

It cannot "FIND" any strings.

macropod · #6 04-17-2012, 10:25 PM

Hi tinfanide,

Try this version:

Code:

Sub Test()
Dim Rng As Range, Str1 As String, Str2 As String
With ThisDocument
  With .Content
    With .Find
      .ClearFormatting
      .MatchWildcards = True
      .Text = "The Principal"
      .Execute
    End With
    If .Find.Found Then
      Set Rng = .Duplicate.Paragraphs.Last.Next.Range
      With Rng
        While Not .Characters.Last Like "[a-z]"
          .End = .End - 1
        Wend
        Str1 = Trim(.Text)
      End With
    End If
  End With
  With .Content
    With .Find
      .ClearFormatting
      .MatchWildcards = True
      .Text = "RE: [!13]@^13"
      .Execute
    End With
    If .Find.Found Then
      Set Rng = .Duplicate
      With Rng
        While Not .Characters.Last Like "[a-z]"
          .End = .End - 1
        Wend
        .Start = .Start + 4
        Str2 = Trim(.Text)
      End With
    End If
  End With
  MsgBox .Path & "\" & Str1 & " " & Str2
  '.SaveAs2 FileName:=ThisDocument.Path & "\" & Str1 & " " & Str2, FileFormat:=wdFormatDocumentDefault
End With
End Sub

if you get a message box with the correct contents, you can delete that line and uncomment the next line.

tinfanide · #7 04-18-2012, 04:47 AM

Quote:

Originally Posted by macropod

Hi tinfanide,

Try this version:

Code:

Sub Test()
Dim Rng As Range, Str1 As String, Str2 As String
With ThisDocument
  With .Content
    With .Find
      .ClearFormatting
      .MatchWildcards = True
      .Text = "The Principal"
      .Execute
    End With
    If .Find.Found Then
      Set Rng = .Duplicate.Paragraphs.Last.Next.Range
      With Rng
        While Not .Characters.Last Like "[a-z]"
          .End = .End - 1
        Wend
        Str1 = Trim(.Text)
      End With
    End If
  End With
  With .Content
    With .Find
      .ClearFormatting
      .MatchWildcards = True
      .Text = "RE: [!13]@^13"
      .Execute
    End With
    If .Find.Found Then
      Set Rng = .Duplicate
      With Rng
        While Not .Characters.Last Like "[a-z]"
          .End = .End - 1
        Wend
        .Start = .Start + 4
        Str2 = Trim(.Text)
      End With
    End If
  End With
  MsgBox .Path & "\" & Str1 & " " & Str2
  '.SaveAs2 FileName:=ThisDocument.Path & "\" & Str1 & " " & Str2, FileFormat:=wdFormatDocumentDefault
End With
End Sub

if you get a message box with the correct contents, you can delete that line and uncomment the next line.

Yes. Thanks for the codes.
With a quite careful look at them, I notice ya've used two

Code:

With .Content
End With

to resolve the problem raised by me last post.

Meanwhile, I'm using

Code:

.Find.Wrap = wdFindContinue

to resolve the problem where the find result keeps the first one, not continues with the subsequent one.

Code:

Sub Macro1()

Dim Str1 As String, Str2 As String
Dim Rng As Range

With ThisDocument
    With .Content

        With .Find
            .ClearFormatting
            .MatchWildcards = True
            .Execute FindText:="The Principal"
        End With
        If .Find.Found Then
            Set Rng = .Duplicate.Paragraphs.Last.Next.Range
            With Rng
                While Not .Characters.Last Like "[a-z]"
                    .End = .End - 1
                Wend
                Str2 = .Text
            End With
        End If
   
        With .Find
            .ClearFormatting
            .MatchWildcards = True
            .Wrap = wdFindContinue
            .Execute FindText:="RE: [!13]@^13"
        End With
        If .Find.Found Then
            Set Rng = .Duplicate
            With Rng
                While Not .Characters.Last Like "[a-z]"
                    .End = .End - 1
                Wend
                .Start = .Start + Len("RE: ")
                Str1 = .Text
            End With
        End If

    End With
End With

Debug.Print Str1 & " " & Str2

End Sub

Similar Threads
Thread	Thread Starter	Forum	Replies	Last Post
Word Visual Basic error - run time error 504	crazymorton	Word	11	01-13-2012 04:32 AM
Microsoft office 2010 error 2908 and error 1935 !!!!!!heeeeellpppp!!!!!!!!!	bennypryde	Office	1	01-05-2012 03:33 PM
Ms Word Error	manesh	Word	1	05-28-2010 07:26 AM
Runtime error 5487 - Word cannot complete the save to to file permission error	franferns	Word	0	11-25-2009 05:35 AM
Receive error cannot open this form because an error occurred in BCM 2007	bornhusker	Outlook	0	06-01-2009 10:28 AM