File SaveAs with Bookmarks

[yohanmcdonal]

I have been looking at fast tracking our file naming for our construction proposals. We have the naming format as a job number followed by a brief description of the project (ex. 01-0111-485 Test Project.docx)

The macro I am writing:
1. Goes down to the "Subject:" paragraph line #8
2. Grabs all the text on that paragraph line after "Subject:"
3. Converts that selection to a bookmark named "Description"
4. Goes down to the "SSi Project #:" paragraph line #9
5. Grabs all the text on that paragraph line after "SSi Project #:"
6. Converts that selection to a bookmark named "Job_Number"
7. Opens the FileSaveAs dialog box
8. Enters the bookmarks as the filename and lets me browse to the needed folder


Sub Proposal_SaveAs()ActiveDocument.Paragraphs(8).Range.Select 'selects project description
With Selection.Find
.Text = "Subject: "
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchAllWordForms = False
.MatchSoundsLike = False
.MatchWildcards = True
End With
Selection.Find.Execute
Selection.MoveRight Unit:=wdCharacter, Count:=1
Selection.EndKey Unit:=wdLine, Extend:=wdExtend
ActiveDocument.Bookmarks.Add _
Name:="Description", Range:=Selection.Range 'creates description bookmark from subject selection
ActiveDocument.Paragraphs(9).Range.Select 'selects job number
With Selection.Find
.Text = "SSi Project #: "
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchAllWordForms = False
.MatchSoundsLike = False
.MatchWildcards = True
End With
Selection.Find.Execute
Selection.MoveRight Unit:=wdCharacter, Count:=1
Selection.EndKey Unit:=wdLine, Extend:=wdExtend
ActiveDocument.Bookmarks.Add _
Name:="Job_Number", Range:=Selection.Range 'creates job number bookmark from job number selection
With Dialogs(wdDialogFileSaveAs) 'creates filename and opens save as dialog box
.Name = ActiveDocument.Bookmarks("Job_Number").Range.Text & " " & ActiveDocument.Bookmarks("Description").Range.Text
.Show
End With
End Sub




Everything works perfectly until I hit "Save". I keep getting "invalid filename" errors. I am pretty good with Excel VBA but new to Word VBA.
Can anyone help troubleshoot this?

[gmayor]

Your code takes no account of illegal filename characters, and without the document to test against, my guess is that you have an illegal paragraph character included as your code works in a mock up based on your document description.

I am not sure what the point of the bookmarks is, as they are not required simply to name the document. As for the rest I would do it differently and ensure there are no illegal filename characters e.g. as follows. Ranges work faster than selections.


Option Explicit

Sub Proposal_SaveAs()
Dim strName As String
Dim strPath As String
Dim oRng As Range
Dim oPara As Paragraph

strPath = Environ("USERPROFILE") & Chr(92) & "Documents" & Chr(92) 'the user's documents folder
For Each oPara In ActiveDocument.Paragraphs
If InStr(1, oPara.Range, "Subject: ") > 0 Then
Set oRng = oPara.Range
oRng.End = oRng.End - 1
strName = Trim(Split(oRng.Text, Chr(58))(1))
Exit For
End If
Next oPara
Set oPara = oPara.Next.Range.Paragraphs(1)
Set oRng = oPara.Range
oRng.End = oRng.End - 1
strName = strName & Chr(32) & Trim(Split(oRng.Text, Chr(58))(1)) & ".docx"
strName = CleanFileName(strName, "docx")
With Dialogs(wdDialogFileSaveAs)
.Name = strPath & strName
.Show
End With
lbl_Exit:
Set oPara = Nothing
Set oRng = Nothing
Exit Sub
End Sub

Public Function CleanFileName(strFilename As String, strExtension As String) As String
'Graham Mayor
'A function to ensure there are no illegal filename
'characters in a string to be used as a filename
'strFilename is the filename to check
'strExtension is the extension of the file
Dim arrInvalid() As String
Dim vfName As Variant
Dim lng_Name As Long
Dim lng_Ext As Long
Dim lngIndex As Long
'Ensure there is no period included with the extension
strExtension = Replace(strExtension, Chr(46), "")
'Record the length of the extension
lng_Ext = Len(strExtension)

'Remove the path from the filename if present
If InStr(1, strFilename, Chr(92)) > 0 Then
vfName = Split(strFilename, Chr(92))
CleanFileName = vfName(UBound(vfName))
Else
CleanFileName = strFilename
End If

'Remove the extension from the filename if present
If Right(CleanFileName, lng_Ext + 1) = "." & strExtension Then
CleanFileName = Left(CleanFileName, InStrRev(CleanFileName, Chr(46)) - 1)
End If

'Define illegal characters (by ASCII CharNum)
arrInvalid = Split("9|10|11|13|34|42|47|58|60|62|63|92|124", "|")
'Add the extension to the filename
CleanFileName = CleanFileName & Chr(46) & strExtension
'Remove any illegal filename characters
For lngIndex = 0 To UBound(arrInvalid)
CleanFileName = Replace(CleanFileName, Chr(arrInvalid(lngIndex)), Chr(95))
Next lngIndex
lbl_Exit:
Exit Function
End Function

[yohanmcdonal]

Thank you so much for the help! I am VERY new to Word VBA and am self taught so my ways of doing things are probably way off. All I had to do to get your code to work was flip the Job# and Description around in the strName. It works great!