Install link or copy to SendTo folder VBS

main Sub Main() Dim answer answer = MsgBox("YES To copy target, NO to Create link, or cancel to stop.", vbYesNoCancel, "YES=Copy, No=Shortcut, Cancel=Cancel") If answer = 6 Then CopyToSendTo elseIf answer = 7 Then InstallShortcutSendTo else MsgBox "Nothing done - exiting" end if End Sub Sub CopyToSendTo() Dim WSH 'As WshShell Dim strSendTo ''send to file path Dim FSO 'As FileSystemObject Dim oFile ''As File 'fp = wscript.Arguments.Item(0) fp = "C:\Users\ron.allen\Documents\CODING\VBS\TempMapFolderDrive\TempMapThisFolderToX.vbs" Set FSO = CreateObject("Scripting.FileSystemObject") Set oFile = FSO.GetFile(fp) Set WSH = CreateObject("WScript.Shell") strSendTo = WSH.SpecialFolders("SendTo") oFile.Copy strSendTo & "\" & oFile.Name, True if fso.fileexists (strSendTo & "\" & oFile.Name) then msgbox "Success installing " & strSendTo & "\" & oFile.Name else Msgox "Error installing " & strSendTo & "\" & oFile.Name end if End Sub Sub InstallShortcutSendTo() Dim WSH ''As WshShell Dim strSendTo ''send to file path Dim FSO ''As FileSystemObject Dim fp ''as string Dim fn ''as String Dim lnk ' Dim oUrlLink '' Dim oFile ''As File 'fp = wscript.Arguments.Item(0) fp = "C:\Users\ron.allen\Documents\CODING\VBS\TempMapFolderDrive\TempMapThisFolderToX.vbs" Set FSO = CreateObject("Scripting.FileSystemObject") Set oFile = FSO.GetFile(fp) Set WSH = CreateObject("WScript.Shell") strSendTo = WSH.SpecialFolders("SendTo") fn = oFile.Name If InStr(1, fn, ".") = 0 Then MsgBox "Malformed file name- no extension - existing", vbCritical, "Error" Exit Sub End If Dim i i = Len(fn) Do While Mid(fn, i, 1) <> "." i = i - 1 Loop fn = Left(fn, i - 1) Set lnk = WSH.CreateShortcut(strSendTo + "\" & oFile.Name & ".lnk") lnk.TargetPath = oFile.Path lnk.WindowStyle = 1 lnk.Hotkey = "" 'lnk.IconLocation = "notepad.exe, 0" lnk.Description = "Original path : " & oFile.Path lnk.WorkingDirectory = strSendTo lnk.Save if fso.fileexists (strSendTo + "\" & oFile.Name & ".lnk") then msgbox "Success installing " & strSendTo + "\" & oFile.Name & ".lnk" else Msgox "Error installing " & strSendTo + "\" & oFile.Name & ".lnk" end if End Sub

Comments

Post a Comment

Popular posts from this blog

Revit area plans adding new types and references (Gross and rentable)

Image
Note to self: Add additional (duplicate) gross area and net area schemed under Area Plans And Area schemes... Really counter-intuitive place to put this instead of say...  Area Plans> New Type> Edit Type (ADD) or Create an area plan, then Go to Properties, Edit Type and Duplicate... Always seem to forget this one! 2015-10-16-And for the calculation type... To update: this also applies to Revit as well as LT- The gross calculations cannot be overridden, however the 'rentable' comes in various flavors... From AD Revit help: Applies to Revit LT 2015 Rules are determined by one type of space bordering another space. The following table shows area measurement rules. To find the appropriate measurement rule, find the selected Area Type and the corresponding Bordering Area Type. Gross Building Area Scheme Types Gross Building Area Scheme Types Area Type Selected Bordering Area Type Measurement Rule Gross Building Area Gross Buil...
Read more

Revit CSV file manager for families and re-exporting to a CSV file

Process: Export a Revit library file - maintains the same name as the family (This is critical) Create an EXCEL file same-name XLSM macro enabled Create a Worksheet "EXPORT" Create other tabs to build data sheets Create a sheet and use DATA LINK to bring in the exported library Copy the important 1st row IDs for the Variable names and types over. All of them are not necessary - only the ones with data Library export ONLY exports parameters that have data in them somewhere Order doesn't matter. Paste the code below into a module Run it to export the "EXPORT" tab Excel saves-as the [excel filename.TXT] Excel saves as the [excel filename.XMSM] Refresh the data source for updates SAVE OFTEN! Version 2.0- The Textfile in VBA has issues - keeps trying to write in Unicode and Kanji instead of basic ASCII. Also Revit format for families is noting in cell 1,1 and all Line Feeds (Not CRLFS or CRs ) at the end of lines. Attribute VB_Nam...
Read more