View Single Post
 
Old 07-20-2014, 02:34 AM
macropod's Avatar
macropod macropod is offline Windows 7 32bit Office 2010 32bit
Administrator
 
Join Date: Dec 2010
Location: Canberra, Australia
Posts: 22,375
macropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond repute
Default

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
__________________
Cheers,
Paul Edstein
[Fmr MS MVP - Word]
Reply With Quote