AW: Desktopverknüpfung erstellen
10.03.2008 22:28:14
Ramses
Hasllo
Das habe ich mal für was anderes gebraucht.
Das was du brauchst kannst du dir ja rausziehen
Sub Erstelle_Verzeichnis_und_Shortcut()
Dim myFSO As Object
Dim myFSOShell As Object
Dim strDesktop As String
Dim myMainFolder As String
Dim mySubFolder As String
Dim myShortCut As Object
Dim myToCopyFile As String, myFileExt As String
'Variablen füllen
myMainFolder = "C:\Ordner1"
mySubFolder = myMainFolder & "\Ordner2"
'OHNE Extension
myToCopyFile = "Mappe1"
myFileExt = ".xls"
Set myFSO = CreateObject("Scripting.FileSystemObject")
Set myFSOShell = CreateObject("WScript.Shell")
'Verzeichnis und Unterverzeichnis anlegen
ChDrive "C:"
If Not myFSO.folderexists(myMainFolder) Or Not myFSO.folderexists(mySubFolder) Then
On Error Resume Next
MkDir myMainFolder
MkDir mySubFolder
End If
'Datei von extrern kopieren
'----
'myFSO.CopyFile "A:\" & myToCopyFile & myFileExt, mySubFolder
'Icon copieren das vorhanden sein muss !!!
'----
'myFSO.CopyFile "A:\" & myToCopyFile & ".ico", mySubFolder
'Verknüpfung auf dem Desktop erzeugen
strDesktop = myFSOShell.SpecialFolders("Desktop")
Debug.Print strDesktop
Set myShortCut = myFSOShell.CreateShortcut(strDesktop + "\" & myToCopyFile & ".lnk")
Debug.Print myShortCut
With myShortCut
'Fenstertyp beim öffnen
' 4=Normal 3=Maximized 7=Minimized
.WindowStyle = 4
.iconlocation = mySubFolder & "\" & myToCopyFile & ".ico"
' oder alternativ ein anderes Icon
'.IconLocation = "C:\graph9.ico"
.Targetpath = mySubFolder & "\" & myToCopyFile & myFileExt
'Keyboard Shortcut zuweisen
.Hotkey = "ALT+CTRL+E"
'Speichern
.Save
End With
End Sub
Gruss Rainer