代码修改

krampaul82 · 发表于 2013-7-8 10:57:53

感谢Keith，我喜欢这段代码。
有没有办法让我重新命名任何*。已经
到*的pdf文件。pdfold而不删除它们？
感谢任何帮助。

Public Sub Gartner _ Get _ Hyperlink _ Main()
Dim obj block As acad block reference
Dim objEnt As acad entity
Dim colHyps As acad hyperlinks
Dim FSO As file system object

Set FSO = New file system object

If Len(Dir(this drawing .路径& " \切割纸张\*。pdf")) 0然后'检查当前_Project\Cut Sheets\
fso中是否有任何pdf。删除此绘图文件。路径& " \切割纸张\*。pdf "，True '如果有，则删除它们
End If

对于此绘图中的每个对象。模型空间
如果对象的类型是AcadBlockReference，则
Set obj block = objEnt
Set colHyps = obj block。“出错时的超链接
继续下一步”以防我们遇到任何没有超链接的块
fso。CopyFile colHyps。项目(0)。URL，此绘图。Path & "\Cut Sheets\ "，True ' The选项将自动覆盖任何同名的现有文件
End If
Next objEnt
Set FSO = Nothing
End Sub

本帖以下内容被隐藏保护；需要你回复后，才能看到！

游客，如果您要查看本帖隐藏内容请回复

Matt__W · 发表于 2013-7-8 14:10:38

这是重命名单个文件的更简单的方法。

copy

Name "c:\temp\123.pdf" As "c:\temp\123.pdfold"

krampaul82 · 发表于 2013-7-9 12:05:33

Matt
如果Len（Dir（ThisDrawing.Path&“\Cut Sheets\*.pdf”）0，则“检查当前\u Project\Cut Sheets\
FSO中是否有pdf，则此操作无效。这幅画的名字。路径-“\Cut Sheets\*.pdf”，作为“\Cut Sheets\*old.pdf”，如果存在，则为True，如果我已关闭，则将其重命名为End）
nfn=Left（fn，Len（fn）-4）&Format（Now（），“_yyyyMMddhhmmss”）&newExtension
名称路径&fn作为路径&nfn
fn=Dir（）
Wend
末端接头

Keith · 发表于 2013-7-9 16:13:14

基思
这个失败我显然没有插入这个正确的
任何sugestions？
Mark
Public Sub RenameFiles（ByVal filter As String， ByVal path As String， ByVal newExtension As String）
Dim fn As String
fn = Dir（ThisDrawing.path & “\Cut Sheets\*.pdf”）
While （fn “”）
nfn = Left（fn， Len（fn） - 4） & Format（Now（）， “*.pdfold”） & newExtension
Name path & fn As path & nfn
fn = Dir（）
Wend
End Sub

krampaul82 · 发表于 2013-7-11 10:11:54

是的，不要修改我提供的代码。它将完全按照您的要求工作。您试图修改它，从而破坏了代码
1）您从代码中删除了过滤器参数。这是要重命名的文件名通配符，即*。pdf或详细信息*。dwg等＜br＞2）您正在硬编码文件的位置，但将其输出到路径参数提供的文件夹中
3）您更改了日期时间格式字符串，并将其替换为*。pdfold..这不是日期格式字符串。这是代码失败的地方，因为它将返回一个既不是.pdfold也不是datetime字符串的字符串
因此，…
要使用它，请将其完全按照我提供的方式放置在vba代码中，并从应用程序中调用它，如下所示：
重命名文件“*.pdf”，ThisDrawing。路径-“\Cut Sheets\”、“.pdfold”
如果您不想让日期时间字符串区分文件的早期版本（这不是一个好主意，但…），请执行以下操作：
替换我提供的函数中的这一行：
带有
的
nfn=Left（fn，Len（fn）-4）和新扩展