时间戳

首页 > 解决方案 > 根据位置保存和重命名文件

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

问题描述

我有工作代码：

  1. 将日期、公司名称和订单号插入到特定位置的证明中（数据从文件位置“C:\2020\My Company\Company Name\COM001 - 01\Layouts”中提取）
  2. 确定文档中的页数
  3. 将步骤 1 粘贴到其他页面上
  4. 将文档导出为 .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

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

标签： vbacoreldraw

解决方案

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

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

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

推荐阅读