VBS SendTo copy file path to clipboard 1

[twomblml]

I have created a script that enables users to right click a file name and choose SendTo -> Email Link. This creates a new Outlook message and pastes the files UNC path into the HTML body of the new message. (Formats the UNC path into an HTML tag <a href=....).

My users loved this so much that they would like the ability to right click a file and copy the file path to the clipboard so they can copy and paste multiple file paths into Outlook messages and other documents. I have change my code to allow this. However, when pasting the path into Outlook, it creates the URL link properly but if the path has spaces in it, it will stop the URL link at the space. So I tried to convert the path to a 8.3 format and unfortunately when you click on it it will not launch the attachment because I guess the URL does not like 8.3.

If anyone has any ideas, I would greatly appreciate any input!

Thanks

Here is my current code with the 8.3 format:

Option Explicit
Dim ws, fso, arFldrs,olapp, ns, olmail, olAttach, olMailItem, strAttach, objNetwork, objDrive, i, strdriveUNC, strunc, Src,_
cnt, strDrive, strPath, Title, Usage, strLinks, fString, objIE, strURL, myString, sSave, fl

Set ws = CreateObject("WScript.Shell")
Set fso = CreateObject("Scripting.FileSystemObject")
Set objNetwork = WScript.CreateObject("WScript.Network")
Set objDrive = objNetwork.EnumNetworkDrives

call BuildPath

Cleanup

Sub CopyPath


On Error GoTo 0
For cnt = 0 To (WScript.Arguments.Count -1)
Src = WScript.Arguments.Item(cnt)
If strPath = "" Then
strAttach = fso.GetAbsolutePathName(Src)
Else
strAttach = fso.GetAbsolutePathName(Src)
strAttach = Mid (strAttach,3)
strAttach = ""&strPath & strAttach&""
'fString = Replace(strAttach, "'", "&#39;")
'myString = Replace(strAttach, " ", "%")
End If
Set fl = fso.GetFile(strAttach)
strLinks = fl.ShortPath & "\" & fl.ShortName
Set objIE = CreateObject("InternetExplorer.Application")
objIE.Navigate("about:blank")
objIE.document.parentwindow.clipboardData.SetData "text", strLinks
objIE.Quit
Next

End Sub

Sub Cleanup
Set ws = Nothing
Set fso = Nothing
Set fl = Nothing
WScript.Quit
End Sub



Sub BuildPath

On Error GoTo 0
For cnt = 0 To (WScript.Arguments.Count -1)
Src = WScript.Arguments.Item(cnt)
For i = 0 to objDrive.Count - 1 Step 2
strdriveUNC = objDrive.Item(i)
strunc = objDrive.Item(i+1)
strdrive = fso.GetDriveName(Src)
If strDrive = strDriveUNC Then
strPath = strunc
End If
Call CopyPath
Next
Next

End Sub

 

[PHV]

if the path has spaces in it, it will stop the URL link at the space
You may try this (type, untested):
strPath = Replace(strPath, " ", "%20")

Hope This Helps, PH.
Want to get great answers to your Tek-Tips questions? Have a look at FAQ219-2884 or FAQ181-2886

 

[twomblml]

PHV I owe you big time for all your help on this board!

That is exactly what I was looking for. As you could see from my code before I was trying to use % as my replacement but it was not working. %20 is exactly what I needed.

Thanks so much!

-Matt

 

[tsuji]

If it is Urlencoding, standard-wise it is this.
[tt] strPath = Replace(strPath, " ", "+")[/tt]
Or I might misunderstand. Just a note as the problem is already resolved.