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

Thread Tools
Show Printable Version Email this Page
Display Modes
Linear Mode Switch to Hybrid Mode Switch to Threaded Mode

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