Saving to Sub Folder

[Coco3]

Hi,



I found macro that opens a directory and converts all files to PDF. I have tried unsuccessfully to modify the script to save to a sub folder called "PDF".

The code is as follows:

Sub SaveAllAsPDF()
Dim strFilename As String
 Dim strDocName As String
 Dim strOutFold As String
 Dim strPath As String
 Dim oDoc As Document
 Dim fDialog As FileDialog
 Dim intPos As Integer
 Set fDialog = Application.FileDialog(msoFileDialogFolderPicker)
 With fDialog
     .Title = "Select folder and click OK"
     .AllowMultiSelect = False
     .InitialView = msoFileDialogViewList
     If .Show <> -1 Then
         MsgBox "Cancelled By User", , "List Folder Contents"
         Exit Sub
     End If
     strPath = fDialog.SelectedItems.Item(1)
     If Right(strPath, 1) <> "\" Then strPath = strPath + "\"
 End With
 If Documents.Count > 0 Then
     Documents.Close SaveChanges:=wdPromptToSaveChanges
 End If
 If Left(strPath, 1) = Chr(34) Then
     strPath = Mid(strPath, 2, Len(strPath) - 2)
 End If
 strFilename = Dir$(strPath & "*.doc")
 While Len(strFilename) <> 0
     Set oDoc = Documents.Open(strPath & strFilename)
     strDocName = ActiveDocument.FullName
     intPos = InStrRev(strDocName, ".")
     strDocName = Left(strDocName, intPos - 1)
'This instruction converts to PDF
       strDocName = strDocName & ".pdf"
     oDoc.SaveAs FileName:=strDocName, _
         FileFormat:=wdFormatPDF
     oDoc.Close SaveChanges:=wdDoNotSaveChanges
     strFilename = Dir$()
 Wend
 
End Sub

Any help would be greatly appreciated.

Thanks,
Megan

[gmayor]

Presumably PDF is a pre-existing sub folder of the original folder in which case

    While Len(strFilename) <> 0
        Set oDoc = Documents.Open(strPath & strFilename)
        strDocName = ActiveDocument.Name 'Use Name not fullname
        intPos = InStrRev(strDocName, ".")
        strDocName = Left(strDocName, intPos - 1)
        'This instruction converts to PDF
        strDocName = strDocName & ".pdf"
        oDoc.SaveAs FileName:=strPath & "PDF\" & strDocName, _
                    FileFormat:=wdFormatPDF 'add the path
        oDoc.Close SaveChanges:=wdDoNotSaveChanges
        strFilename = Dir$()
    Wend

If you want to create the folder then see the Createfolders function at https://www.gmayor.com/useful_vba_functions.htm where you will also find code to ensure the filenames are unique to avoid overwriting duplicated names.

[Coco3]

Thank-you very much!

I actually tried that, but got an error and being a total newbie to this, I thought I was wrong. I checked my folder permissions and I have a read-only permissions problem.

Thank you again for your help. And I'll definitely be checking out your site to learn more about this.