You could use:
Code:
Private Sub CommandButton1_Click()
Dim MBxAns
Dim i As Long
Dim Fldr As String
Dim StrNm As String
Dim vrtSelectedItem As Variant
Dim wdDoc As Document
MBxAns = MsgBox("Did you update the SWMS Number?", vbYesNo, "Bunny Check...")
If MBxAns <> vbYes Then Exit Sub
Fldr = GetFolder & "\"
If Fldr = "\" Then Exit Sub
MBxAns = MsgBox(Fldr, vbOKCancel, "The Destination Folder is...")
If MBxAns = vbCancel Then Exit Sub
With Application.FileDialog(msoFileDialogFilePicker)
.InitialFileName = "G:\QMS\OH&S"
.Title = "Select the SWMS Templates"
.AllowMultiSelect = True
If .Show = -1 Then
For Each vrtSelectedItem In .SelectedItems
Set wdDoc = Documents.Open(FileName:=vrtSelectedItem)
With wdDoc
.Fields.Update
StrNm = "SWMS " & .Bookmarks("SWMSNumber").Range.Text & " " & _
.Bookmarks("SWMSType").Range.Text & " - " & _
.Bookmarks("PrimaryContractor").Range.Text & " - " & _
.Bookmarks("ProjectName").Range.Text
.BuiltInDocumentProperties("Title") = StrNm
.BuiltInDocumentProperties("Subject") = .Bookmarks("SWMSType").Range.Text
With Dialogs(wdDialogFileSaveAs)
.Name = Fldr & StrNm & ".pdf"
.Format = wdFormatPDF
.Show
End With
.Close SaveChanges:=False
End With
Next
End If
End With
MsgBox "remember to secure the PDF before sending"
'ActiveDocument.Close SaveChanges:=False
End Sub
Function GetFolder() As String
Dim oFolder As Object
GetFolder = ""
Set oFolder = CreateObject("Shell.Application").BrowseForFolder(0, "Choose a folder", 0)
If (Not oFolder Is Nothing) Then GetFolder = oFolder.Items.Item.Path
Set oFolder = Nothing
End Function
You'll not the BrowseForFolder method takes four arguments. These are detailed at:
http://msdn.microsoft.com/en-us/libr...(v=vs.85).aspx . The last of these allows you to set a root folder. This isn't just a starting folder, though. If you specify "G:\Admin - MASTER\Customers\", your users won't be able to browse to any higher folder. So you might need to use "G:\Admin - MASTER\", or even '"G:\".
Alternatively, if you're wedded to using 'Application.FileDialog(msoFileDialogFilePicker)', you could change:
Code:
If .Show = -2 Then Exit Sub
Fldr = .SelectedItems(1)
to:
Code:
If .Show = -1 Then
Fldr = .SelectedItems(1)
Else
Exit Sub
End If