Visual Basic - Re: Create desktop shortcut

Author

Re: Create desktop shortcut

Matt Williamson

2004-03-29, 4:30 pm

Lloyd-

I'd recommend just creating the shortcuts as you copy over the files.

Take a look at this search, you'll find what you're looking for

http://groups.google.com/groups?q=vb+shelllnk

HTH

Matt

"Lloyd Cox" <lcox400w@hotmail.com> wrote in message
news:75BEFE1E-A15B-4299-8D13-991BD9CDB97A@microsoft.com...
> I have a VB6 program that copies files from a server to users desktops.
The program copies about 70 different files and keeps them up to date with
the copies on the server. The issue I have is creating desktop shortcuts.
Users like them organized in nice folders for easier access. Currently I
created all the shortcuts by hand and I copy them from the server to the
desktop, but this method takes a lot of work when a file changes or is
added.
>
> Is there a way in VB6 to programatically have VB look at a directory and
then create the appropriate shortcuts on the desktop in the specified folder
I want without the extention? I have researched this and cant find anything
that comes close. Any help would be appreciated.

Lloyd Cox

2004-03-29, 5:30 pm

The copy routine I use copies all files in about 20 directories to the local workstation. The method you suggest requires me to put in code for each file which is what I am trying to avoid. I was hoping to find some code that would take all the files in
a directory and put shortcuts in a folder on the desktop with the same name, minus the extension.

----- Matt Williamson wrote: -----

Lloyd-

I'd recommend just creating the shortcuts as you copy over the files.

Take a look at this search, you'll find what you're looking for

http://groups.google.com/groups?q=vb+shelllnk

HTH

Matt

"Lloyd Cox" <lcox400w@hotmail.com> wrote in message
news:75BEFE1E-A15B-4299-8D13-991BD9CDB97A@microsoft.com...
> I have a VB6 program that copies files from a server to users desktops.
The program copies about 70 different files and keeps them up to date with
the copies on the server. The issue I have is creating desktop shortcuts.
Users like them organized in nice folders for easier access. Currently I
created all the shortcuts by hand and I copy them from the server to the
desktop, but this method takes a lot of work when a file changes or is
added.[color=darkred]
then create the appropriate shortcuts on the desktop in the specified folder
I want without the extention? I have researched this and cant find anything
that comes close. Any help would be appreciated.

Matt Williamson

2004-03-29, 5:30 pm

Lloyd-

Post your copy routine so I can see what you're referring to. Perhaps it
isn't as efficient as it should be. You should be able to just add the code
to create the shortcut in the loop for your copy routine. While you could
do it after the fact, I think it would be better to do it in the same loop.

HTH

Matt

"Lloyd Cox" <lcox400w@hotmail.com> wrote in message
news:A7DDF64B-1068-4002-B152-FE9BD0D37F17@microsoft.com...
> The copy routine I use copies all files in about 20 directories to the
local workstation. The method you suggest requires me to put in code for
each file which is what I am trying to avoid. I was hoping to find some
code that would take all the files in a directory and put shortcuts in a
folder on the desktop with the same name, minus the extension.
>
> ----- Matt Williamson wrote: -----
>
> Lloyd-
>
> I'd recommend just creating the shortcuts as you copy over the files.
>
> Take a look at this search, you'll find what you're looking for
>
> http://groups.google.com/groups?q=vb+shelllnk
>
> HTH
>
> Matt
>
>
> "Lloyd Cox" <lcox400w@hotmail.com> wrote in message
> news:75BEFE1E-A15B-4299-8D13-991BD9CDB97A@microsoft.com...
desktops.[color=darkred]
> The program copies about 70 different files and keeps them up to date
with
> the copies on the server. The issue I have is creating desktop
shortcuts.
> Users like them organized in nice folders for easier access.
Currently I
> created all the shortcuts by hand and I copy them from the server to
the
> desktop, but this method takes a lot of work when a file changes or
is
> added.
directory and[color=darkred]
> then create the appropriate shortcuts on the desktop in the specified
folder
> I want without the extention? I have researched this and cant find
anything
> that comes close. Any help would be appreciated.
>
>
>

Larry Serflaten

2004-03-29, 6:34 pm

"Lloyd Cox" <lcox400w@hotmail.com> wrote
> The copy routine I use copies all files in about 20 directories to the local workstation. The method you suggest requires me to
put in code for each file which is what I am trying to avoid. I was hoping to find some code that would take all the files in a
directory and put shortcuts in a folder on the desktop with the same name, minus the extension.

I would think a shortcut to the folder would be the easier solution.
The users would get a folder on their desktop, as you indicate,
and you could continue to update it, without any addition code.
Because it is a shortcut to the actual folder, it always reflects
the current contents of the folder, every time they open it up.

To set it up initially, you could tell the users to use Explorer to go
to the folder that you will be updating, then grab the icon that is
in the text area of the Address bar and drag that to their desktop.
Viola! They have a shortcut to your folder....

LFS

Lloyd Cox

2004-03-29, 8:30 pm

Matt,

Its quite long, so I will give you some pieces. The first section is the routine that runs to copy files from the server to specific locations on the workstation. Thanks in advance! There are about 31 different directories:

If dirnum = 1 Then
sSourcePath = "\\pdres001\MSWord\2000Templates\Report Forms - Server Version\"
sDestination = "c:\templates\Report Forms - Server Version\"
sFiles = "*.dot"
GoTo updatefiles
End If

'Directory #2
If dirnum = 2 Then
sSourcePath = "\\pdres001\MSWord\2000Templates\Fto\"
sDestination = "c:\templates\Fto\"
sFiles = "*.dot"
GoTo updatefiles
Else
End If

'Directory #3
If dirnum = 3 Then
sSourcePath = " \\pdres001\MSWord\2000Templates\Warrants
\"
sDestination = "c:\templates\Warrants\"
sFiles = "*.dot"
GoTo updatefiles
Else
End If

The below code is from the updatefiles code:

updatefiles:

'perform the copy and return the copied file count
numCopied = rgbUpdateFiles(dirnum, sSourcePath, sDestination, sFiles)

dirnum = dirnum + 1
If dirnum > 1 Then GoTo continueupdate

The code below is from the function rgbUpdateFiles. Please excuse all my coments, but I have been testing and it helps me....I am pretty new:

Public Function rgbUpdateFiles(dirnum, sSourcePath As String, _
sDestination As String, _
sFiles As String) As Long

Dim WFD As WIN32_FIND_DATA
Dim SA As SECURITY_ATTRIBUTES

Dim r As Long
Dim hFile As Long
Dim bNext As Long
Dim copied As Long
Dim currFile As String

Dim localdate As Date
Dim serverdate As Date

'Create the target directory if it doesn't exist
Call CreateDirectory(sDestination, SA)

'Start searching for files in the Target directory.
hFile = FindFirstFile(sSourcePath & sFiles, WFD)

If (hFile = INVALID_HANDLE_VALUE) Then

'nothing to do, so bail out
MsgBox "No " & sFiles & " files found."
Exit Function

End If

'Copy each file to the new directory
If hFile Then

Do

'trim trailing nulls, leaving one to terminate the string
currFile = Left$(WFD.cFileName, InStr(WFD.cFileName, Chr$(0)))

On Error GoTo nofile

Dim testfile1 As String, nametotest1 As String
nametotest1 = sDestination & currFile
testfile1 = Dir(nametotest1)
If Len(testfile1) = 0 Then
'MsgBox "file does not exist"
GoTo xupdcopy
Else
'MsgBox "file does exist"
'serverdate = FileDateTime(sDestination & currFile)
'localdate = FileDateTime(sDestination & currFile)
End If

'MsgBox "Local date is: " & localdate & Chr(13) & "Server date is: " & serverdate & Chr(13) & "Filename: " & currFile
'Dim test
'test = DateDiff("s", FileDateTime(sSourcePath & currFile), FileDateTime(sDestination & currFile))
'MsgBox test

If DateDiff("s", FileDateTime(sSourcePath & currFile), FileDateTime(sDestination & currFile)) >= 0 Then
'MsgBox "local is current"
GoTo yupdloop
Else
'MsgBox "local is old, copy new file"
End If

xupdcopy:
On Error Resume Next
'***This directory number must match the directory number above***
If dirnum = 20 Then
Label2 = "Deleting file: " & currFile
Me.Refresh
'MsgBox sSourcePath & currFile, vbCritical, "Deleting File"
DeleteFile sSourcePath & currFile
Me.Refresh

Else
Label2 = "Copying file: " + currFile
Me.Refresh
'copy the file to the destination directory & increment the count
Call CopyFile(sSourcePath & currFile, sDestination & currFile, False)
copied = copied + 1

'just to check what's happening
'ORGIONAL LINE List1.AddItem sSourcePath & currFile
ProgressBar1 = ProgressBar1 + 1
DoEvents
'List1.AddItem "Copied to " & sDestination & currFile
Me.Refresh

End If

yupdloop:
'find the next file matching the initial file spec
bNext = FindNextFile(hFile, WFD)

Loop Until bNext = 0

End If

'Close the search handle
Call FindClose(hFile)

'and return the number of files copied
rgbUpdateFiles = copied

nofile:
'Dim msgerr As Long
'msgerr = errnum
'MsgBox msgerr

If Err = 53 Then
GoTo xupdcopy
End If

End Function

Matt Williamson

2004-03-31, 3:30 pm

Lloyd-

I've been looking over your code and I don't want to offend at all, but I
can't really do much with it. I'd have to re-write it from scratch because
it doesn't seem to be very efficient and I abhor using goto for anything but
error handling.

I do have a program that copies a single file to multiple file paths that
are definable in an external file. It would be pretty trivial to add
multiple from locations and have it create shortcuts as well. If you want to
see that code, I'd be happy to send it to you. It's a bit too much to post
here though.

From the way you've written your code, it isn't at all easy to add new files
without re-compiling everytime.

HTH

Matt

"Lloyd Cox" <lcox400w@hotmail.com> wrote in message
news:9DCC8A9B-5630-45BD-8A8D-5E78E72AE06C@microsoft.com...
> Matt,
>
> Its quite long, so I will give you some pieces. The first section is the
routine that runs to copy files from the server to specific locations on the
workstation. Thanks in advance! There are about 31 different directories:
>
> If dirnum = 1 Then
> sSourcePath = "\\pdres001\MSWord\2000Templates\Report Forms - Server
Version\"
> sDestination = "c:\templates\Report Forms - Server Version\"
> sFiles = "*.dot"
> GoTo updatefiles
> End If
>
> 'Directory #2
> If dirnum = 2 Then
> sSourcePath = "\\pdres001\MSWord\2000Templates\Fto\"
> sDestination = "c:\templates\Fto\"
> sFiles = "*.dot"
> GoTo updatefiles
> Else
> End If
>
> 'Directory #3
> If dirnum = 3 Then
> sSourcePath = " \\pdres001\MSWord\2000Templates\Warrants
\"
> sDestination = "c:\templates\Warrants\"
> sFiles = "*.dot"
> GoTo updatefiles
> Else
> End If
>
>
> The below code is from the updatefiles code:
>
> updatefiles:
>
> 'perform the copy and return the copied file count
> numCopied = rgbUpdateFiles(dirnum, sSourcePath, sDestination, sFiles)
>
> dirnum = dirnum + 1
> If dirnum > 1 Then GoTo continueupdate
>
> The code below is from the function rgbUpdateFiles. Please excuse all my
coments, but I have been testing and it helps me....I am pretty new:
>
> Public Function rgbUpdateFiles(dirnum, sSourcePath As String, _
> sDestination As String, _
> sFiles As String) As Long
>
> Dim WFD As WIN32_FIND_DATA
> Dim SA As SECURITY_ATTRIBUTES
>
> Dim r As Long
> Dim hFile As Long
> Dim bNext As Long
> Dim copied As Long
> Dim currFile As String
>
> Dim localdate As Date
> Dim serverdate As Date
>
> 'Create the target directory if it doesn't exist
> Call CreateDirectory(sDestination, SA)
>
> 'Start searching for files in the Target directory.
> hFile = FindFirstFile(sSourcePath & sFiles, WFD)
>
> If (hFile = INVALID_HANDLE_VALUE) Then
>
> 'nothing to do, so bail out
> MsgBox "No " & sFiles & " files found."
> Exit Function
>
> End If
>
> 'Copy each file to the new directory
> If hFile Then
>
> Do
>
> 'trim trailing nulls, leaving one to terminate the string
> currFile = Left$(WFD.cFileName, InStr(WFD.cFileName, Chr$(0)))
>
> On Error GoTo nofile
>
> Dim testfile1 As String, nametotest1 As String
> nametotest1 = sDestination & currFile
> testfile1 = Dir(nametotest1)
> If Len(testfile1) = 0 Then
> 'MsgBox "file does not exist"
> GoTo xupdcopy
> Else
> 'MsgBox "file does exist"
> 'serverdate = FileDateTime(sDestination & currFile)
> 'localdate = FileDateTime(sDestination & currFile)
> End If
>
> 'MsgBox "Local date is: " & localdate & Chr(13) & "Server date is: " &
serverdate & Chr(13) & "Filename: " & currFile
> 'Dim test
> 'test = DateDiff("s", FileDateTime(sSourcePath & currFile),
FileDateTime(sDestination & currFile))
> 'MsgBox test
>
> If DateDiff("s", FileDateTime(sSourcePath & currFile),
FileDateTime(sDestination & currFile)) >= 0 Then
> 'MsgBox "local is current"
> GoTo yupdloop
> Else
> 'MsgBox "local is old, copy new file"
> End If
>
> xupdcopy:
> On Error Resume Next
> '***This directory number must match the directory number above***
> If dirnum = 20 Then
> Label2 = "Deleting file: " & currFile
> Me.Refresh
> 'MsgBox sSourcePath & currFile, vbCritical, "Deleting File"
> DeleteFile sSourcePath & currFile
> Me.Refresh
>
> Else
> Label2 = "Copying file: " + currFile
> Me.Refresh
> 'copy the file to the destination directory & increment the count
> Call CopyFile(sSourcePath & currFile, sDestination & currFile,
False)
> copied = copied + 1
>
> 'just to check what's happening
> 'ORGIONAL LINE List1.AddItem sSourcePath & currFile
> ProgressBar1 = ProgressBar1 + 1
> DoEvents
> 'List1.AddItem "Copied to " & sDestination & currFile
> Me.Refresh
>
> End If
>
> yupdloop:
> 'find the next file matching the initial file spec
> bNext = FindNextFile(hFile, WFD)
>
> Loop Until bNext = 0
>
> End If
>
> 'Close the search handle
> Call FindClose(hFile)
>
> 'and return the number of files copied
> rgbUpdateFiles = copied
>
> nofile:
> 'Dim msgerr As Long
> 'msgerr = errnum
> 'MsgBox msgerr
>
> If Err = 53 Then
> GoTo xupdcopy
> End If
>
> End Function
>
>
>
>

Sponsored Links