Corel Draw特定的VBA-根据位置保存并重命名文件

如何解决Corel Draw特定的VBA-根据位置保存并重命名文件

我是这个论坛的新手，这是我发布的第一个问题，因为我更喜欢尝试自己弄清楚VBA的编码，并从其他各种编码人员那里获取一点点，并将其编译以创建并完成我需要的任务。

现在..这是我当前面临的问题。我通过CorelDraw使用VBA来自动化重复性的任务，例如保存证明供客户在生产产品之前注销。

在过去的8个月左右的时间里，我开发了一个冗长的代码，直到现在完成了工作，整个过程相当简单。

将日期，公司名称和订单号插入到特定位置的证明中（从文件位置“ C：\ 2020 \ 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,"\") - 1)
    FolderPath = Left(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

我感觉代码在“有关文件部分的拉动信息”中弄乱了，但是老实说我目前不能确定。

如果对此有任何指导，将不胜感激，或者如果您知道一种更简单的方法来完成此操作。

预先感谢

解决方法

您需要以一种可以检查最终路径的方式存储它，然后再使用它。在这里交换这段代码：

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更改为所需的值。

原来这是一个有关文件路径不返回任何信息的简单问题。

更改了此代码，现在可以正常使用

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

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

Corel Draw特定的VBA-根据位置保存并重命名文件

如何解决Corel Draw特定的VBA-根据位置保存并重命名文件

解决方法

相关推荐