Author Topic: Code ammendment  (Read 5068 times)

0 Members and 1 Guest are viewing this topic.

krampaul82

  • Guest
Code ammendment
« on: July 08, 2013, 10:57:53 AM »
Love this code following code thanks to Keith.
Is there a way I can re-name any *.pdf files that are allready there
to *.pdfold without deleting them?
any help appreciated.




Public Sub Gartner_Get_Hyperlink_Main()
    Dim objBlock As AcadBlockReference
    Dim objEnt As AcadEntity
    Dim colHyps As AcadHyperlinks
    Dim fso As FileSystemObject
   
   
Set fso = New FileSystemObject
   
    If Len(Dir(ThisDrawing.Path & "\Cut Sheets\*.pdf")) <> 0 Then ' Checks to see if there are any PDFs in CURRENT_Project\Cut Sheets\
        fso.DeleteFile ThisDrawing.Path & "\Cut Sheets\*.pdf", True ' If there are, delete them
    End If
   
   
   
   
   
   
    For Each objEnt In ThisDrawing.ModelSpace
        If TypeOf objEnt Is AcadBlockReference Then
            Set objBlock = objEnt
            Set colHyps = objBlock.Hyperlinks
            On Error Resume Next ' In case we encounter any blocks that DON'T have hyperlinks
            fso.CopyFile colHyps.Item(0).URL, ThisDrawing.Path & "\Cut Sheets\", True ' The TRUE option will automatically overwrite any existing files with the same name
        End If
    Next objEnt
    Set fso = Nothing
End Sub

Matt__W

  • Seagull
  • Posts: 12955
  • I like my water diluted.
Re: Code ammendment
« Reply #1 on: July 08, 2013, 02:10:38 PM »
This would be a simpler way to rename a single file.

Code: [Select]
Name "c:\temp\123.pdf" As "c:\temp\123.pdfold"
Autodesk Expert Elite
Revit Subject Matter Expert (SME)
Owner/FAA sUAS Pilot @ http://skyviz.io

krampaul82

  • Guest
Re: Code ammendment
« Reply #2 on: July 09, 2013, 12:05:33 PM »
Matt
this does not work

If Len(Dir(ThisDrawing.Path & "\Cut Sheets\*.pdf")) <> 0 Then ' Checks to see if there are any PDFs in CURRENT_Project\Cut Sheets\
        FSO.Name ThisDrawing.Path & "\Cut Sheets\*.pdf", As "\Cut Sheets\*old.pdf", True' If there are, rename them
    End If

am I close?
Mark

Keith™

  • Villiage Idiot
  • Seagull
  • Posts: 16899
  • Superior Stupidity at its best
Re: Code ammendment
« Reply #3 on: July 09, 2013, 04:13:14 PM »
If you are simply wanting to rename any existing .PDF documents to .PDFOLD, this will be possible, however, I must caution you that there will be a problem if the target name is that of an existing file when the function is executed a second time.

For example:
thisfile.pdf is renamed to thisfile.pdfold

Later a new pdf file is created called thisfile.pdf

If the function is called again, it will try to rename thisfile.pdf to thisfile.pdfold, but thisfile.pdfold will already exist, meaning a crash and burn for the application.

What you might find as a better solution is to use a value that is incremented globally and will never be repeated. A datetime value works great in this instance. So, you might rename thisfile.pdf to thisfile_201309070337.pdfold .. this way, the next time the application is executed, the filename is incremented by the time lapsed between the last time it ran and NOW.

So, what you might want to do is this:

Code - Visual Basic: [Select]
  1. 'filter is a string that will be used to match files i.e. use "*.pdf" to match all PDF files or "a*.pdf" to match all PDF files that start with "a"
  2. 'you can also specify certain file names or use other wildcard values like this: "??.pdf" which will find all PDF files named with two characters
  3. 'path is a fully qualified path to the location of the files that should be searched i.e. "C:\Users\User\Documents\"
  4. 'newExtension is the extension you want the files to have when the rename is done i.e. ".pdfold"
  5.  
  6. Public Sub RenameFiles(ByVal filter As String, ByVal path As String, ByVal newExtension As String)
  7.     Dim fn As String
  8.     fn = Dir(path & filter)
  9.     While (fn <> "")
  10.         nfn = Left(fn, Len(fn) - 4) & Format(Now(), "_yyyyMMddhhmmss") & newExtension
  11.         Name path & fn As path & nfn
  12.         fn = Dir()
  13.     Wend
  14. End Sub
  15.  

Proud provider of opinion and arrogance since November 22, 2003 at 09:35:31 am
CadJockey Militia Field Marshal

Find me on https://parler.com @kblackie

krampaul82

  • Guest
Re: Code ammendment
« Reply #4 on: July 11, 2013, 10:11:54 AM »

Keith
this fails I obviously did not plug this in right
any 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

Keith™

  • Villiage Idiot
  • Seagull
  • Posts: 16899
  • Superior Stupidity at its best
Re: Code ammendment
« Reply #5 on: July 11, 2013, 10:31:15 AM »

Keith
this fails I obviously did not plug this in right
any sugestions?
Mark

yes, do not modify the code I provided. It will work for what you want exactly like it is. You broke the code by trying to modify it.
1) You removed the filter parameter from the code. This is the filename wildcard you want to rename i.e. *.pdf or detail*.dwg etc.
2) You are hard coding the location of the files but outputting them to a folder as supplied by the Path parameter.
3) You changed the datetime format string and replaced it with *.pdfold .. this IS NOT a date format string. This is where the code will fail because it will return a string that is neither .pdfold nor a datetime string.

So ....

To use it, place it in the vba code exactly as I provided it and call it from your application like this:
Code - Visual Basic: [Select]
  1. RenameFiles "*.pdf", ThisDrawing.Path & "\Cut Sheets\", ".pdfold"
  2.  

If you don't want the datetime string to differentiate previous versions of the files (not a good idea but....) do this:
Replace this line in the function I provided:
Code - Visual Basic: [Select]
  1. nfn = Left(fn, Len(fn) - 4) & Format(Now(), "_yyyyMMddhhmmss") & newExtension
  2.  

with

Code - Visual Basic: [Select]
  1. nfn = Left(fn, Len(fn) - 4) & newExtension
  2.  

Proud provider of opinion and arrogance since November 22, 2003 at 09:35:31 am
CadJockey Militia Field Marshal

Find me on https://parler.com @kblackie

krampaul82

  • Guest
Re: Code ammendment
« Reply #6 on: July 11, 2013, 11:07:01 AM »

 :-o
nfn = Left(fn, Len(fn) - 4) & Format(Now(), "_yyyyMMddhhmmss") & newExtension
Fails
Left is Highlighted and the msg
"Cannot find project or Library" shows
At your convienence...

krampaul82

  • Guest
Re: Code ammendment
« Reply #7 on: July 11, 2013, 11:27:50 AM »
Keith
Forgot to declare nfn as string
works now :kewl:
Thank you for your patience......

Keith™

  • Villiage Idiot
  • Seagull
  • Posts: 16899
  • Superior Stupidity at its best
Re: Code ammendment
« Reply #8 on: July 11, 2013, 11:49:28 AM »
Ah, the ole .. option explicit/option strict

I don't use it in VBA
Proud provider of opinion and arrogance since November 22, 2003 at 09:35:31 am
CadJockey Militia Field Marshal

Find me on https://parler.com @kblackie