Create shortcuts on remote desktop

Hi, can you please explain a little more?

If you have
u123c1:psr123a

do you want to copy
\\auprifile01\psr123a\my_documents.lnk
to
\\u123c1\c$\documents and settings\psr123a\desktop\my_documents.lnk

Thanks,

Rob.

As per RobSampson comment, Can you confirm the shortcut already exists or does that need to be created ?

If its just a copy the attached code should work, I can post the code to just create a shortcut if that is required.

Const ForReading = 1

CurrentLineNum=0
Set oFSO = CreateObject("Scripting.FileSystemObject")
Set oTextFile = oFSO.OpenTextFile ("Inputlist.txt", ForReading)

Do Until oTextFile.AtEndOfStream
 sLine = oTextFile.ReadLine
 arrLine=split(sline,":")

 CopyFrom = "\\auprifile01\" & arrline(0) & "\my_documents.lnk"
 CopyTo =   "c:\documents and settings\" & arrline(1) & "\desktop\"
 
 wscript.echo "Copying: " & CopyFrom & " to: & CopyTo
 If oFSO.FileExists() Then
   filesys.CopyFile CopyFrom, CopyTo
 End If

Loop

Select allOpen in new window

If you just need to create a shortcut to the network folders then the following should work.

Const ForReading = 1

Set WshShell = CreateObject("WScript.Shell")
Set oFSO = CreateObject("Scripting.FileSystemObject")
Set oTextFile = oFSO.OpenTextFile ("Inputlist.txt", ForReading)

Do Until oTextFile.AtEndOfStream
 sLine = oTextFile.ReadLine
 arrLine=split(sline,":")

 ShortcutTarget = "\\auprifile01\" & arrline(0) & "\my_documents"
 ShortcutPath =   "c:\documents and settings\" & arrline(1) & "\desktop\My Documents on AUPRIFILE01.lnk"

 Set objShortcutLnk = WshShell.CreateShortcut(ShortcutPath)
 objShortcutLnk.TargetPath = ShortcutTarget
 objShortcutLnk.Save
 set objShortcutLnk=nothing

Loop

Select allOpen in new window

Hey Rob  !

All i want the script to do is create a shortcut on the desktop as per attachment

 1. Use the input file so as to know to which computer (u123c1) to send it to.
 2  Use the username (psr123a) to know where to copy it to on the desktop.

In a nutshell  the user should see on his computer desktop a shortcut  as per attachment.
N.B Should be mapped to H: drive.

Sorry about the confusion
Thanks
Cheers




Shortcut.bmp

So are you saying for the input file:

u123c1:psr123a

This should create a shortcut to \\auprifile01\psr123a\my_documents
The shortcut needs be created on \\u123c1\documents and settings\prs123a\desktop\
And look something like "Shortcut to My_Documents on AUPRIFILE01"

Const ForReading = 1

Set WshShell = CreateObject("WScript.Shell")
Set oFSO = CreateObject("Scripting.FileSystemObject")
Set oTextFile = oFSO.OpenTextFile ("Inputlist.txt", ForReading)

Do Until oTextFile.AtEndOfStream
 sLine = oTextFile.ReadLine
 arrLine=split(sline,":")

 ShortcutTarget = "\\auprifile01\" & arrline(1) & "\my_documents"
 ShortcutPath =   "\\" & arrline(0) & "\documents and settings\" & arrline(1) & "\desktop\Shortcut to My_Documents on AUPRIFILE01.lnk"

 Set objShortcutLnk = WshShell.CreateShortcut(ShortcutPath)
 objShortcutLnk.TargetPath = ShortcutTarget
 objShortcutLnk.Save
 set objShortcutLnk=nothing

Loop

Select allOpen in new window

To Rob & Gundog Trainer

The following Code was used to send a lnk to a list of remote computers (attached list). I want to be able to do the same but send a shorcut (as per previous attached bmp) to appear on their desktop.

Dim objFSO, objFile, wmiQuery, objWMIService, objPing, objStatus
Set objShell = CreateObject("WScript.Shell")
Set objWMIService = GetObject("winmgmts:\\.\root\cimv2")
ComputersList = objShell.ExpandEnvironmentStrings("%USERPROFILE%") & "\Desktop\inputlist2.txt"
SourceFile    = objShell.ExpandEnvironmentStrings("%USERPROFILE%") & "\Desktop\e-Learning.url"
Const intForAppending = 8
ReportFile = objShell.ExpandEnvironmentStrings("%USERPROFILE%") & "\Desktop\outputlist2.txt"
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objOutput = objFSO.OpenTextFile(ReportFile, intForAppending, False)
arrComputers  = Split(objFSO.OpenTextFile(ComputersList).ReadAll,vbNewLine)
 
For Each PC in arrComputers
  username = "psr" & mid(pc,2,3) & "a"
  Set objping = objWMIService.ExecQuery("Select * From Win32_PingStatus Where " & "Address = '" & PC & "'")
  for each objstatus in objping
       If IsNull(objStatus.StatusCode) Or objStatus.Statuscode <> 0 Then
           ResolveIP = PC & " " & "Failed"
       Else
                DestinationPath = "\\" & PC & "\C$\" & "Documents and Settings\" & username & "\desktop\"
                If objFSO.FolderExists(DestinationPath) = True Then
                 objFSO.CopyFile SourceFile, DestinationPath
                 ResolveIP = PC & " " & objStatus.ProtocolAddress & " Done"
           Else
                 ResolveIP = PC & " " & DestinationPath & " was not found."
           End If
       End If
       ObjOutput.WriteLine(resolveip)
  next
Next

objOutput.Close

Wscript.echo "Job Done"


Thanks
Cheers

Inputlist2.txt

I think that I will have to send this little vbs via email to these users

Dim objShell, strUserName, objnetwork
Set objShell = CreateObject("wscript.Shell")
strUserName = objShell.ExpandEnvironmentStrings("%UserName%")
Set objNetwork = CreateObject("WScript.Network")
objNetwork.MapNetworkDrive "P:", "\\tyrenet-14\transfer\" & strusername & "\my_documents

It will show as a Network Drive in My Computers.

What can I do to this little code to make the shortcut display on their desktop ?

Thanks
Cheers

Okay..I've been a bit further to the point to have the following script save the shortcut on the desktop. One way to have all remote users have it is to send it via email...is there a way by a vbscript to rund that to all remote computers

Dim objShell, strUserName, objnetwork
Set objShell = CreateObject("wscript.Shell")
strUserName = objShell.ExpandEnvironmentStrings("%UserName%")

Set objNetwork = WScript.CreateObject("Wscript.Network")
Set oFSO = CreateObject("Scripting.FileSystemObject")

If Not oFSO.DriveExists("P:") Then
objNetwork.MapNetworkDrive "P:", "\\tyrenet-14\transfer\" & strusername
End If

set WshShell = WScript.CreateObject("Wscript.Shell")
strDesktop = WshShell.SpecialFolders("Desktop")

set objShortcut = WshShell.CreateShortcut(strDesktop & "\\My_Documents.lnk")

objShortcut.Description = "Network Source File Storage"

objShortcut.TargetPath = "\\tyrenet-14\transfer\" & strusername & "\my_documents"

objShortcut.IconLocation = "C:\Windows\System32\shell32.dll, 19"

objShortcut.Save

Top

Rob,

After testing the script on live computer it seems that I will need to pass on a local\administrator & password

Can you modify the code for me

OK, try this.  It should map a drive to the IPC$ share of each computer as it goes, providing admin access.

Regards,

Rob.

strInputFile = "ComputerUsers.txt"
strLocalUser = "administrator"
strLocalPassword = "localpassword"

Dim objShell, objFSO, objInput, strComputer, strUser, objShortcut, strLine
Const ForReading = 1

Set objShell = CreateObject("WScript.Shell")
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objNetwork = CreateObject("WScript.Network")

Set objInput = objFSO.OpenTextFile(strInputFile, ForReading, False)
While Not objInput.AtEndOfStream
	strLine = objInput.ReadLine
	If InStr(strLine, ":") > 0 Then
		strComputer = Split(strLine, ":")(0)
		strUser = Split(strLine, ":")(1)
		If Ping(strComputer) = True Then
			On Error Resume Next
			objNetwork.MapNetworkDrive "", "\\" & strComputer & "\IPC$", False, strLocalUser, strLocalPassword
			If objFSO.FolderExists("\\" & strComputer & "\C$\Documents and Settings\" & strUser & "\Desktop") = True Then
				Set objShortcut = objShell.CreateShortcut("\\" & strComputer & "\C$\Documents and Settings\" & strUser & "\Desktop\My_Documents.lnk")
				objShortcut.Description = "Network Source File Storage"
				objShortcut.TargetPath = "\\tyrenet-14\transfer\" & strUser & "\my_documents" 
				objShortcut.IconLocation = "C:\Windows\System32\shell32.dll, 19"
				objShortcut.Save 
			End If
			objNetwork.RemoveNetworkDrive "\\" & strComputer & "\IPC$", True, False
			If Err.Number <> 0 Then
				WScript.Echo "Error connecting to " & strComputer & VbCrLf & "Error " & Err.Number & ": " & Err.Description
				Err.Clear
			End If
			On Error GoTo 0
		End If
	End If
Wend
objInput.Close

Function Ping(strComputer)
	Dim objShell, boolCode
	Set objShell = CreateObject("WScript.Shell")
	boolCode = objShell.Run("Ping -n 1 -w 300 " & strComputer, 0, True)
	If boolCode = 0 Then
		Ping = True
	Else
		Ping = False
	End If
End Function

Select allOpen in new window