create shortcut to active document and place in a folder

[Larry]

This is really a vba question yet I neglected initially to send it to
the vba group.. I've cancelled the original messages, which had some
mistakes, and I'm starting over.

Is there a command that I could run through VBA that would create a
shortcut to the active Word document and place that shortcut in a
particular folder? Let's say the folder is: C:\Documents\Work

The manual equivalent of this, which I already have, is to add to the
Windows/SendTo folder a shortcut to a .vbs file which sends a shortcut
of the document to the folder. But I want to automate this from within
Word.

Here is the code of the .vbs file. A shortcut to this .vbs file is in
my Windows\SendTo folder. :

Dim fso, Package, PkgName, Destination, link, Top, I

Destination = "C:\Documents\Work"

Set shell = CreateObject("WScript.Shell")
Set fso = CreateObject("Scripting.FileSystemObject")
Top = WScript.Arguments.Count
For I = 0 To (Top-1)
Package = WScript.Arguments.Item(I)
PkgName=fso.GetBaseName(Package)
Set link = shell.CreateShortcut(Destination&"\"&PkgName&".lnk")
link.TargetPath = (Package)
link.Save
Next
' MsgBox "Shortcuts to the file(s) or folder(s) are being created
at:"&vbCRLF&Destination
Set shell = Nothing
Set fso = Nothing

Also, in addition to placing a shortcut in the folder, would there be a
command I could run through VBA that would delete the shortcut of the
active document from the C:\Documents\Work folder?

I'm basically trying to come up with a more powerful equivalent of
Word's Work
menu.

I'm working with Word 97, on Windows 98.

Thanks,
Larry

 

[Peter Hewett]

Hi Larry

It seems you have all the pieces of your puzzle already. Here's a modified version of the
code that will create a shortcut to the ActiveDocument (it it's been saved):

Public Sub CreateShortCut()
' Requires a project reference to "Windows Script Host Object Model"
Dim shl As IWshRuntimeLibrary.WshShell
Dim objLink As Object
Dim lngPos As Long
Dim strDestination As String
Dim strPackageName As String

' If the current documents not been saved then we can't create a shortcut
If LenB(ActiveDocument.Path) = 0 Then Exit Sub

' Path for link file
strDestination = "C:\Temp\"

' Just want the name part (no file type)
lngPos = InStrRev(ActiveDocument.Name, ".")
If lngPos > 0 Then
strPackageName = Left$(ActiveDocument.Name, lngPos - 1)
End If

' Create the shortcut to the current document
Set shl = New IWshRuntimeLibrary.WshShell
Set objLink = shl.CreateShortCut(strDestination & strPackageName & ".lnk")
objLink.TargetPath = (ActiveDocument.FullName)
objLink.Save

Set objLink = Nothing
Set shl = Nothing
End Sub

To delete the shortcut, just delete the link file:
Dim strDestination As String
Dim strPackageName As String

' Just want the name part (no file type)
lngPos = InStrRev(ActiveDocument.Name, ".")
If lngPos > 0 Then
strPackageName = Left$(ActiveDocument.Name, lngPos - 1)
End If
Kill "C\Temp\" & strPackageName & ".lnk"

HTH + Cheers - Peter

 

[Larry]

Hi Peter,

Thanks for this.

As you told me, I checked the Windows Script Host Object Model under
Tools, References. But when I try to run the macro, I get a message
saying "sub or function not defined" and InStrRev is highlighted in the
below line:

lngPos = InStrRev(ActiveDocument.Name, ".")

InStrRev is not mentioned in VB Help, so I experimented with changing it
to

lngPos = InStr(ActiveDocument.Name, ".")

Now when I run the macro, I get a run-time error, and when I click on
Debug, the below line is highlighted:

objLink.Save

If we could get this working it would be great. It would be a more
powerful substitute for the Work menu. I found a couple of articles on
the web about creating a shortcut through vba, but they were were
written for programmers and too complicated for me to understand.

Larry

 

[Howard Kaikow]

I suspect you are using Word 97.
You need word 2000, or later, for Instrrev.

 

[Peter Hewett]

Hi Larry

Sorry, I realised after I had signed off for the evening that you said you were using Word
97 . Use this version instead:

Public Sub CreateShortCut()
' Requires a project reference to "Windows Script Host Object Model"
Dim fso As IWshRuntimeLibrary.FileSystemObject
Dim shl As IWshRuntimeLibrary.WshShell
Dim objLink As Object
Dim lngPos As Long
Dim strDestination As String
Dim strPackageName As String

' If the current documents not been saved then we can't create a shortcut
If LenB(ActiveDocument.Path) = 0 Then Exit Sub

' Path for link file
strDestination = "C:\Temp\"

' Just want the name part (no file type)
Set fso = New IWshRuntimeLibrary.FileSystemObject
strPackageName = fso.GetBaseName(ActiveDocument.Name)

' Create the shortcut to the current document
Set shl = New IWshRuntimeLibrary.WshShell
Set objLink = shl.CreateShortCut(strDestination & strPackageName & ".lnk")
objLink.TargetPath = (ActiveDocument.FullName)
objLink.Save

Set objLink = Nothing
Set shl = Nothing
Set fso = Nothing
End Sub

HTH + Cheers - Peter

 

[Larry]

Hi Peter,

I tried the new one, but as before, I a get run-time error, and when I
click on Debug, this line is highlighted:

objLink.Save

Larry

 

[Larry]

Hi Larry

It seems you have all the pieces of your puzzle already. Here's a
modified version of the code that will create a shortcut to the
ActiveDocument (it it's been saved):

Public Sub CreateShortCut()
' Requires a project reference to "Windows Script Host Object
Model" Dim shl As IWshRuntimeLibrary.WshShell
Dim objLink As Object
Dim lngPos As Long
Dim strDestination As String
Dim strPackageName As String

' If the current documents not been saved then we can't create a
shortcut If LenB(ActiveDocument.Path) = 0 Then Exit Sub

' Path for link file
strDestination = "C:\Temp\"

' Just want the name part (no file type)
lngPos = InStrRev(ActiveDocument.Name, ".")
If lngPos > 0 Then
strPackageName = Left$(ActiveDocument.Name, lngPos - 1)
End If

' Create the shortcut to the current document
Set shl = New IWshRuntimeLibrary.WshShell
Set objLink = shl.CreateShortCut(strDestination & strPackageName
& ".lnk") objLink.TargetPath = (ActiveDocument.FullName)
objLink.Save

Set objLink = Nothing
Set shl = Nothing
End Sub

To delete the shortcut, just delete the link file:
Dim strDestination As String
Dim strPackageName As String

' Just want the name part (no file type)
lngPos = InStrRev(ActiveDocument.Name, ".")
If lngPos > 0 Then
strPackageName = Left$(ActiveDocument.Name, lngPos - 1)
End If
Kill "C\Temp\" & strPackageName & ".lnk"

HTH + Cheers - Peter

 

[Larry]

I've got a macro working which deletes the existing shortcut of the
active document from the folder, but I use a different approach to get
the name of a document without the extension: WordBasic.FileNameInfo:

Dim myFileName As String, myShortcut
myFileName = WordBasic.FileNameInfo(ActiveDocument.Name, 4)
myShortcut = Dir("C:\Documents\Work\Current work\" & myFileName &
".lnk")

If myShortcut <> "" Then
Kill "C:\Documents\Work\Current work\" & myFileName & ".lnk"
MsgBox "Shortcut to this document has been deleted from Current Work
folder."
Else
MsgBox "Shortcut to this document doesn't exist in Current Work
folder."
End If

Larry

 

[Larry]

Also, with all the statements in this code, when I click in them and
press F1 for help, I get "Keyword not found." Does that indicate that
the objects referred to don't exist?

Larry

 

[Howard Kaikow]

'Requires a project reference to "Windows Script Host Object Model"

 

[Peter Hewett]

Hi Howard Kaikow

As Howard stated (and as clearly stated in the code sample) you require a project
reference to the "Windows Script Host Object Model". Did this clear up the problem?

Cheers - Peter

'Requires a project reference to "Windows Script Host Object Model"

HTH + Cheers - Peter

 

[Larry]

I checked Windows Script Host Object Model in Tools, References, as I
mentioned earlier. However, is a project reference something more than
that? For example, the WSHOM is checked in my Normal template. But I
also have a global add-in template, and WSHOM is not checked for that
project. But I've placed your code in my Normal, so that should not be
a problem, I guess.

Larry

 

[Howard Kaikow]

The reference needs to be in the project in which you have the code.

It is better to have separate templates for app specific stuff and keep as
little as possible in the Normal template.
I would suggest creating a separate template. Call it, say, LarrysTools and
put the code in that template. Then ad a project reference in that template
to the scripting host.

You would then use that template either by attaching it directly to relevant
documents, or if needed more often, put the template in Word's Startup
directory.

 

[Larry]

Howard,

Ok, I've followed your advice and moved the macro to my global template,
Larry's Global, and I've checked Windows Script Host Object Model in
Tools, References for Larry's Global.

But the result is the same, when I run the macro I get run-time error
with this line highlighted:

objLink.Save

Larry

P.S. On a side point, as I've pointed out before, there is a
significant loss of functionality for macros placed in a globa template.
For one thing, such macros cannot be opened from the Macros dialog box.
Instead the template has to be opened as a document and then the macro
found via the code window, all of which takes several steps more than
opening a macro that's in Normal. Secondly, key assignments made to
macros in a global template do not display consistently in the Customize
Keyboard dialog box; this makes it necessary for me to maintain a
document with my own lists of key assignments.

Despite these problems, I keep many macros in my global template (in
fact the size of my global template is about 1.3 MB), mainly to keep
down the size of Normal (which is now about 1.5 MB), but nevertheless
the lack of functionality for macros in a global should not be ignored.

Larry

 

[Howard Kaikow]

Howard,

Ok, I've followed your advice and moved the macro to my global template,
Larry's Global, and I've checked Windows Script Host Object Model in
Tools, References for Larry's Global.

But the result is the same, when I run the macro I get run-time error
with this line highlighted:

objLink.Save

The directory C:\Temp must previously exist, or the code has to create the
critter.

P.S. On a side point, as I've pointed out before, there is a
significant loss of functionality for macros placed in a globa template.

Lemmee clarify.

For one thing, such macros cannot be opened from the Macros dialog box.

Yes, global templates are not intended to be changed interactively, rather a
template that is dstill undergoing changes is not a candidate for use as a
global template.

In my case, I keep separate copies for modification, then replace the global
copy as needed.

Secondly, key assignments made to
macros in a global template do not display consistently in the Customize
Keyboard dialog box; this makes it necessary for me to maintain a
document with my own lists of key assignments.

I don't use key assignments, so I cannot say that I've noticed this
behavior.

 

[Larry]

The directory C:\Temp must previously exist, or the code has to create the
critter.

As you can see from the code previously posted, my actual destination
folder is "C:\Work\Current Work\" rather than "C:\Temp\". "C\Temp\" was
just a name that Peter provided. And the Current Work\ folder does
exist. Unless your saying that that the destination folder must be
named C:\Temp?

If that's not the problem, do you have any idea why this macro is not
working?

Larry







yes, of course, the folder

Path for link file
' strDestination = "C:\Temp\"
strDestination = "C:\Work\Current Work\"

 

[Howard Kaikow]

The directory can be whatever you put in the code, as long as it exists.
It might be a good idea to test for existence of the directory and, if the
critter does not exist, create it in the code.

What is the exact text of the run-time error message you are receiving?

 

[Howard Kaikow]

I tried the code in both Word 97 and Word 2003, worked with no problem.

 

[Larry]

Here is the run-time error message:

Run-time error '-2147467259 (80004005)':

U

I don't need to test for the existence of the folder because the folder
already exists. All the shortcuts are being send to the same folder
which I am trying to set up as a more functional substitute for Word's
Work menu.

It's hopeful sign that you get this working in your Word 97. The
impression that I got from reading about this on the web was that such a
macro needed to be extremely complicated, much more complicated than
what we're dealing with here.

Larry

 

[Howard Kaikow]

For error 80004005, you'll need to search at the MSDN developer site and at
the MSFT KB to find all relevant articles.
There are a lot of articles for that error code.

I got that error a few months ago and it took a bit to find the cause.

Since I can run the code in my Word 97, I would expect that somehow you have
a reference to an incorrect version of some library.

It's good programming practice to check for the existence of a directory.
Someday, you might use the code elsewhere or rename the directory and forget
the impact.
Testing for the existence avoids those problems.