Convert templates to documents

timf · #1 05-04-2020, 10:26 AM

Quote:

Originally Posted by macropod

You can convert a whole folder of documents with a simple macro:

Code:

Sub ConvertFiles()
Application.ScreenUpdating = False
Dim strFolder As String, strFile As String, wdDoc As Document
strFolder = GetFolder
If strFolder = "" Then Exit Sub
strFile = Dir(strFolder & "\*.doc", vbNormal)
While strFile <> ""
  If InStrRev(strFile, ".docx") = 0 Then
    Set wdDoc = Documents.Open(FileName:=strFolder & "\" & strFile, _
      AddToRecentFiles:=False, Visible:=False)
    wdDoc.SaveAs2 FileName:=strFolder & "\" & Left(strFile, InStrRev(strFile, ".doc")) & "docx", _
      Fileformat:=wdFormatXMLDocument, AddToRecentFiles:=False
    wdDoc.Close SaveChanges:=False
  End If
  strFile = Dir()
Wend
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 a folder", 0)
If (Not oFolder Is Nothing) Then GetFolder = oFolder.Items.Item.Path
Set oFolder = Nothing
End Function

This code works great but I'm trying to make it a little more precise. I'm trying to allow the user to pick several files from a certain folder, convert them from *.dotx to *.docx, then send them to another folder. The macro runs as far as selecting multiple files then goes straight to ending the sub, skipping over the actual conversion coding. Is what I'm trying to do possible?

Code:

Sub ConvertFile()
Application.ScreenUpdating = False
Dim wdApp As New Word.Application
Dim wdDoc As Word.Document
Dim strfolder As String, strFile As String
Dim sDocName As String, fnlfolder As String


MsgBox "Select the Destination Folder", vbInformation
fnlfolder = GetFolder

MsgBox "Select the Folder Containing the .dotx Files You Need to Convert", vbInformation
If strfolder = "" Then
    With Application.FileDialog(msoFileDialogFilePicker)
    .AllowMultiSelect = True
      If .Show = -1 Then
        Set wdDocSrc = ActiveDocument
      Else
        MsgBox "No Source document chosen. Exiting", vbExclamation
        Exit Sub
      End If
    End With
strFile = Dir(strfolder & "\*.dotx", vbNormal)
wdApp.DisplayAlerts = False
While strFile <> ""
Set wdDoc = wdApp.Documents.Open(FileName:=strfolder & "\" & strFile, AddToRecentFiles:=False, Visible:=False, ReadOnly:=True)
    With wdDoc
    sDocName = Left(strFile, Len(strFile) - 5)
    sDocName = sDocName & ".docx"
    wdDoc.SaveAs2 FileName:=fnlfolder & "\" & sDocName, FileFormat:=wdFormatDocumentDefault, AddToRecentFiles:=False
    wdDoc.Close savechanges:=False
    strFile = Dir()
    End With
Wend
wdApp.Quit
Set wdDoc = Nothing: Set wdApp = Nothing: Set WkSht = Nothing
Application.ScreenUpdating = True
MsgBox ("Operation Complete")
End If
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

macropod · #2 05-04-2020, 02:17 PM

If all you're doing is converting one template at a time, you're wasting your time trying to do it with a macro. Simply double-click on the template, then use Save As to save the resulting document wherever you like. Otherwise, the code would have to be entirely different from what you've cobbled together.

timf · #3 05-04-2020, 02:29 PM

It would be more like 50 files out of a folder that has around 300. My idea was to keep the user out of the folder so they don’t accidentally select cut instead of copy when they’re grabbing the files they need. Plus it would be a one stop thing where they can select the files they need, convert then to .docx, then place them where they need to be.

Is this not the route I should be taking then?

Thank you for your help

macropod · #4 05-04-2020, 05:51 PM

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

timf · #5 05-05-2020, 04:20 AM

Wow, that works perfectly and makes much more sense. Thanks!

Similar Threads
Thread	Thread Starter	Forum	Replies	Last Post
How To Move Saved New Templates From My Documents To My Templates?	woodbine	Word	9	04-02-2015 10:28 AM
Templates and New Documents Baased on Styles	Andrewmb	Word	4	07-08-2012 08:16 PM
Open documents changing font on subsequent templates	mikmak	Word	7	03-04-2012 08:23 PM
Assigning templates to existing documents. Update Styles Enmasse.	bannerdog	Word	1	02-28-2012 03:53 PM
Programmatically convert Office documents to PDF from C#	hemaneelagiri	Office	0	10-21-2011 06:07 AM