Starnes Student
Starnes Student

Reputation: 105

In Excel-Word Interop, how do I use the File Object after using the Name function to rename it?

Overall objective: create an Excel-based file converter that interops with Word, changing several built-in document properties, header/footer text & pics, watermark, and file name. The new attributes/text/file paths are found in cells. After changing all these attributes, et al, the file is to be copied as a regular .docx to a new Output folder and also exported as a PDF to a separate PDF Output folder. Optionally the files in the input folder will be deleted after the other steps are completed.

Specific problem: After I rename any of the files using the Name function, the File Object (I'm using File Scripting Object) loses its reference to the old file (since it's renamed), but does not pick up on the new, renamed file. After renaming the file, I would like to make a copy of it into the word document output folder; then, with the original, I would export it to the PDF output folder. Finally, I would either delete it or leave it alone, depending on an optional boolean.

I have attempted to re-assign the File Object with the new file, but this doesn't seem to be possible, and nothing else in its properties or methods makes sense to use.

Sub ChangeProperties()

    Dim wordApp As Word.Application
    Dim wordDoc() As Word.Document

    Dim fso As New FileSystemObject
    Dim fo(3) As Folder
    Dim f As file

    Dim cvSht As Worksheet
    Dim fileSht As Worksheet

    Dim progShp As Shape

    Dim fileRng(0 To 13) As Range
    Dim optRng As Range

    Dim i As Long
    Dim n As Long
    Dim count As Long

    Set wordApp = Word.Application

    ' Dashboard sheet
    Set cvSht = Sheets("Convert")
    ' Sheet where user types new attributes or views old attributes
    Set fileSht = Sheets("FileAttributes")

    ' Folder objects
    Set fo(1) = fso.GetFolder(cvSht.Range("F3").Value)
    Set fo(2) = fso.GetFolder(cvSht.Range("F5").Value)
    Set fo(3) = fso.GetFolder(cvSht.Range("F7").Value)
    ChDir (fo(1) & Application.PathSeparator)

    Set optRng = cvSht.Range("H13")
    ' Just some user-defined true/false input cells
    optERR = optRng
    optMSG = optRng.Offset(1, 0)
    optPDF = optRng.Offset(2, 0)
    optDOC = optRng.Offset(3, 0)
    optRMV = optRng.Offset(4, 0)

    ' Run some pre-execution checks to prevent catastrophic failure
    If fo(1).Files.count > 20 Then

        MsgBox "Too many files in folder.  Please only 20 files at a time.", vbOKOnly, "Error!"
        Exit Sub

    End If

    For i = 0 To 13
        Set fileRng(i) = fileSht.Range("D27").Offset(0, i)
    Next

    n = 1

    If InStr(1, fileRng(0).Offset(n - 1, 0), "doc") = 0 Then
        MsgBox "New file names must end with a proper extension, i.e. - .docx", vbCritical, "Terminating Process!"
        Exit Sub
    End If

    For Each f In fo(1).Files
        For i = 0 To fo(1).Files.count
            If fileRng(0).Value = f.Name Then
                MsgBox "New file names must be different from the existing file names!  Aborting...", vbCritical, "Terminating Process!"
                Exit Sub
            End If
        Next
    Next

    For Each f In fo(1).Files

        If optERR = False Then On Error Resume Next

        If Left(f.Name, 1) = "~" Then GoTo Nxt
        Set wordDoc(n) = wordApp.Documents.Open(f.Path)

        ' -------- Clipped out middle parts for clarity ---------

        If fileRng(0).Offset(n - 1, 0) <> "" Then
        End If

        On Error GoTo 0

        wordDoc(n).Save

        Application.Wait Now + 0.00003
        Application.StatusBar = "Processing..." & n & "/" & fo(1).Files.count

        If optPDF Then

            If Right(f, 1) = "x" Then
                wordDoc(n).ExportAsFixedFormat fo(2) & Application.PathSeparator & _
                VBA.Replace(f.Name, ".docx", ".pdf"), wdExportFormatPDF
            ElseIf Right(f, 1) = "c" Then
                wordDoc(n).ExportAsFixedFormat fo(2) & Application.PathSeparator & _
                VBA.Replace(f.Name, ".doc", ".pdf"), wdExportFormatPDF
            ElseIf Right(f, 1) = "m" Then
                wordDoc(n).ExportAsFixedFormat fo(2) & Application.PathSeparator & _
                VBA.Replace(f.Name, ".docm", ".pdf"), wdExportFormatPDF
            End If

        End If

        wordDoc(n).Close

        **Name f.Name As fileRng(0).Offset(n - 1, 0).Value**   ' Causes the next lines to fail
        **Set f = fileRng(0).Offset(n - 1, 0).Value** ' Attempt to reassign fails
        **If optDOC Then f.Copy (fo(3) & "/")**  ' This would fail too
        If optRMV Then f.Delete

Nxt:

        On Error GoTo 0
        n = n + 1

    Next

End Sub

Upvotes: 0

Views: 66

Answers (0)

Related Questions