根据位置保存和重命名文件

Question

我有工作代码：

将日期、公司名称和订单号插入证明的特定位置（数据从文件位置“C:20\My Company\Company Name\COM001 - 01\Layouts")
确定文档中的页数
将步骤 1 粘贴到其他页面上
将文档导出为 .pdf

我想要实现的是，在保存 .pdf 文件之前重命名文件（在本例中为 COM001 - 01）添加版本指示器（“_v1”），然后保存 .cdr 文件，然后运行.pdf 导出功能，但不会覆盖原来的。

我一直在尝试改编我在电子表格大师上找到的代码。

该代码添加了版本指示器并将 .pdf 导出到正确的文件位置，但只要我在不同的位置打开另一个文件，它就会将其保存在以前的位置。

这是那段代码：（如果需要，我可以上传整个代码。）

Private Sub SaveNewVersion()
    'PURPOSE: Save file, if already exists add a new version indicator to filename

    Dim FolderPath, myPath, SaveName, SaveExt, VersionExt As String
    Dim Saved As Boolean
    Dim x As Long
    Saved = False
    x = 1

    'Version Indicator (change to liking)
    VersionExt = " _v"

    'Pull info about file
    On Error GoTo NotSavedYet
    myPath = ActiveDocument.FileName
    myFileName = Mid(myPath, InStrRev(myPath, "\") + 1, InStrRev(myPath, ".") - InStrRev(myPath, "\") - 1)
    FolderPath = Left(myPath, InStrRev(myPath, "\"))
    SaveExt = "." & Right(myPath, Len(myPath) - InStrRev(myPath, "."))
    On Error GoTo 0

    'Determine Base File Name
    If InStr(1, myFileName, VersionExt) > 1 Then
        myArray = Split(myFileName, VersionExt)
        SaveName = myArray(0)
    Else
        SaveName = myFileName
    End If

    'Need a new version made
    Do While Saved = False
        If FileExist(FolderPath & SaveName & VersionExt & x & SaveExt) = False Then
            ActiveDocument.SaveAs FolderPath & SaveName & VersionExt & x & SaveExt
            Saved = True
        Else
            x = x + 1
        End If
    Loop
    Exit Sub

'Error Handler
NotSavedYet:
    MsgBox "This file has not been initially saved. " & _
      "Cannot save a new version!", vbCritical, "Not Saved To Computer"
End Sub


Function FileExist(FilePath As String) As Boolean
    'PURPOSE: Test to see if a file exists or not
    Dim TestStr As String
    'Test File Path (ie "C:\Users\Chris\Desktop\Test\book1.xlsm")
    On Error Resume Next
    TestStr = Dir(FilePath)
    On Error GoTo 0

    'Determine if File exists
    If TestStr = "" Then
        FileExist = False
    Else
        FileExist = True
    End If
End Function

我感觉代码在“关于文件部分的拉取信息”中搞砸了。

Answer 1

您需要以一种可以在使用前进行检查的方式存储最终路径。在此处交换此代码块：

Dim newFileName as String
newFileName = FolderPath & SaveName & VersionExt & x & SaveExt
Debug.Print newFileName 
If FileExist(newFileName) = False Then
    ActiveDocument.SaveAs newFileName 
    Saved = True
Else
    x = x + 1
End If

这将在保存发生之前将最终文件名打印到即时Window。如果不正确，请将 newFileName 更改为您想要的任何内容。

Answer 2

事实证明这是一个关于文件路径未返回任何信息的简单问题..

修改了这段代码，现在可以完美运行了

 On Error GoTo NotSavedYet
    myFile = ActiveDocument.FileName
    myPath = (ActiveDocument.FilePath)
    myFileName = Mid(myFile, InStrRev(myFile, "\") + 1, InStrRev(myFile, ".") - InStrRev(myFile, "\") - 1)
    FolderPath = Left(myPath, InStrRev(myPath, "\"))
    SaveExt = "." & Right(myFile, Len(myFile) - InStrRev(myFile, "."))
    Debug.Print FolderPath
  On Error GoTo 0

感谢@HackSlash 的提示，非常感谢

根据位置保存和重命名文件

Save and Rename File based on location

vba

coreldraw