View Single Post
 
Old 05-04-2020, 05:51 PM
macropod's Avatar
macropod macropod is offline Windows 7 64bit Office 2010 32bit
Administrator
 
Join Date: Dec 2010
Location: Canberra, Australia
Posts: 22,369
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

Try:
Code:
Sub ExportDocs()
Application.ScreenUpdating = False
Dim strFolder As String, wdDoc As Document, i As Long
With Application.FileDialog(FileDialogType:=msoFileDialogFilePicker)
  .Title = "Select the source document containing the Find/Replace Table"
  .AllowMultiSelect = True
  If .Show = -1 Then
    strFolder = GetFolder
    If strFolder = "" Then
      MsgBox "No output folder selected. Exiting", vbCritical
      Exit Sub
    End If
    For i = 1 To .SelectedItems.Count
      Set wdDoc = Documents.Add(.SelectedItems(i))
      With wdDoc
        .SaveAs2 FileName:=strFolder & "\" & Split(.AttachedTemplate.Name, ".dot")(0) & ".docx", _
          Fileformat:=wdFormatXMLDocument, AddToRecentFiles:=False
        .Close False
      End With
    Next
  Else
    MsgBox "No source file selected. Exiting", vbExclamation
    Exit Sub
  End If
End With
Set wdDoc = Nothing
Application.ScreenUpdating = True
End Sub

Function GetFolder() As String
Dim oFolder As Object
GetFolder = ""
Set oFolder = CreateObject("Shell.Application").BrowseForFolder(0, "Choose an output folder", 0)
If (Not oFolder Is Nothing) Then GetFolder = oFolder.Items.Item.Path
Set oFolder = Nothing
End Function
__________________
Cheers,
Paul Edstein
[Fmr MS MVP - Word]
Reply With Quote