excel - 文档已创建，但文件名不正确并保存在不正确的位置

问题描述

我有一个代码检查文档是否存在于特定位置，如果不存在，则创建并保存到该特定位置。

检查的代码是正确的，但是当文档不存在时，会创建一个文档，但它会以文件夹路径 + 文件名的文件名保存到顶部文件夹。应该保存文档的文件夹确实存在。

我在我的代码中做错了什么？

先感谢您。

例子：

我双击打开“求职信”，它不存在，因此应按如下方式创建和保存：

L:Templates/1.0 求职信/求职信.docx

相反，它是按如下方式创建和保存的：

L:Templates/1.0 Cover Letter_Cover Letter.docx

Public Sub subTemplate()

''this macro creates an empty template document with header and property information
    Cells(ActiveCell.Row, ActiveSheet.Range("zz_templates").Column).Activate
    
    Range("zz_preventloop").Value = "x"
    Application.ScreenUpdating = False
          
    Dim DocType As String
    If Range("zz_officeversion").Value = "previous to 2007" Then
    DocType = ".doc"
    Else
    DocType = ".docx"
    End If
        

'check the document type
    If Cells(ActiveCell.Row, ActiveSheet.Range("zz_doctype_template").Column).Value = ".url" Then ''Opening the .url shortcut
        On Error Resume Next
        ActiveWorkbook.FollowHyperlink Range("zz_envelope_templates").Value + "/" + ActiveSheet.Cells(ActiveCell.Row, ActiveSheet.Range("zz_locations_temp").Column).Value + "/" _
        + ActiveSheet.Cells(ActiveCell.Row, ActiveSheet.Range("zz_hidden_eDMStemp").Column).Value + ".url", NewWindow:=True
    Else
        If Cells(ActiveCell.Row, ActiveSheet.Range("zz_doctype_template").Column).Value = ".docx" Then
            Application.Calculate
            On Error Resume Next
            Set Word = GetObject(, "Word.Application")
            If Word Is Nothing Then
                Set Word = CreateObject("Word.Application")
            End If
        'to check if the template already exists:
            Dim filename As String
            filename = Range("zz_envelope_templates").Value + "/" + ActiveSheet.Cells(ActiveCell.Row, ActiveSheet.Range("zz_locations_temp").Column).Value + "/" _
            + ActiveSheet.Cells(ActiveCell.Row, ActiveSheet.Range("zz_hidden_eDMStemp").Column).Value + DocType
            filename = Replace(filename, "<", "[")
            filename = Replace(filename, ">", "]")
            If Dir(filename) = "" Then
            'to return to activesheet (QQ) after selection (because of activating sheet 'Header')
                Dim QQ As String
                QQ = ActiveSheet.Name
                Dim propTitle As String
                Dim propSubject As String
                propTitle = Range("zz_envelope_title").Value ''Property Title (= CTD Name)
                propSubject = Range("zz_envelope_OFN").Value ''Property Subject (= Output Filename)
                Application.GoTo Range("zz_envelope_header")
                Selection.COPY ''Copy the header information from sheet 'Header', the script to paste this is within the 'Template' document
                Sheets(QQ).Activate
                Word.Visible = True
            'create properties from previously created strings
                Word.Documents.Open (Range("zz_envelope_templates").Value + "\template" + DocType)
                Word.Activedocument.BuiltinDocumentProperties("Title") = Cells(ActiveCell.Row, ActiveSheet.Range("zz_CTD").Column).Value
                Word.Activedocument.BuiltinDocumentProperties("Subject") = Cells(ActiveCell.Row, ActiveSheet.Range("zz_OFN").Column).Value
                If Len(Cells(ActiveCell.Row, ActiveSheet.Range("zz_header_CTDnr").Column).Value) > 0 Then
                    Word.Activedocument.CustomDocumentProperties("CTDnrHeader") = Cells(ActiveCell.Row, ActiveSheet.Range("zz_header_CTDnr").Column).Value + " "
                Else
                    Word.Activedocument.CustomDocumentProperties("CTDnrHeader") = Cells(ActiveCell.Row, ActiveSheet.Range("zz_header_CTDnr").Column).Value
                End If
                Word.Activedocument.CustomDocumentProperties("SubjectHeader") = Cells(ActiveCell.Row, ActiveSheet.Range("zz_header_subject").Column).Value
                Word.Activedocument.CustomDocumentProperties("TitleHeader") = Cells(ActiveCell.Row, ActiveSheet.Range("zz_header_title").Column).Value
                Word.Activedocument.CustomDocumentProperties("SubtitleHeader") = Cells(ActiveCell.Row, ActiveSheet.Range("zz_header_subtitle").Column).Value
                Word.Activate
                Word.Activedocument.ActiveWindow.ActivePane.VIEW.SeekView = 10 ''footer field update
                Word.Selection.WholeStory
                Word.Selection.Fields.Update
                Word.Activedocument.ActiveWindow.ActivePane.VIEW.SeekView = 9 ''header fields update
                Word.Selection.WholeStory
                Word.Selection.Fields.Update
                Word.Activedocument.ActiveWindow.ActivePane.VIEW.SeekView = 0 ''main document
                AppActivate Application.Caption
                Cells(ActiveCell.Row, ActiveSheet.Range("zz_hidden_tempID").Column).Value = Word.Activedocument.BuiltinDocumentProperties("Category")
                Word.Activate
                Word.Activedocument.SaveAs filename:=Replace(filename, "/", "_") ''Document now saved on the eDMS home location
            Else
                Word.Visible = True
                Word.Documents.Open (filename)
                Word.Activate
                AppActivate Application.Caption
                Word.Activate
                Word.Activedocument.Save
            End If
        End If
    End If
    Range("zz_preventloop").Value = ""
    Application.ScreenUpdating = True
End Sub

标签： excelvba

excel - 文档已创建，但文件名不正确并保存在不正确的位置

问题描述

解决方案

推荐阅读