kısayol oluşturmak

[sekand]

selamlar
hocalarımız aşağıdaki kod ile yardımda bulunursa sevinirim
bu kod ile kısayol oluşturmak istiyorum ancak program files klasörünü komple atıyor kısayola sadece dosyayı kısayola almak istiyorum
saygılar

Declare Function SHGetSpecialFolderLocation Lib "Shell32" _
(ByVal hwnd As Long, ByVal nFolder As Long, ppidl As Long) As Long

Declare Function SHGetPathFromIDList Lib "Shell32" _
(ByVal Pidl As Long, ByVal pszPath As String) As Long

Declare Function SetWindowPos Lib "User32" (ByVal hwnd As Long, ByVal hWndInsertAfter As Long, _
ByVal X As Long, ByVal Y As Long, ByVal cx As Long, _
ByVal cy As Long, ByVal uFlags As Long) As Long

Declare Function SetForegroundWindow Lib "User32" _
(ByVal hwnd As Long) As Long

Declare Function GetForegroundWindow Lib "User32" () As Long

Function ShortCut(Target As String, Optional Target_Type As Long) As Boolean
Dim hwnd As Long
Dim Pidl As Long
Dim Bureau As String

If Dir(Target & IIf(Target_Type = vbDirectory, "\", ""), _
Target_Type) = "" Then Exit Function
SHGetSpecialFolderLocation 0, 0, Pidl
Bureau = Space(260)
SHGetPathFromIDList Pidl, Bureau
Bureau = Left(Bureau, InStr(1, Bureau, vbNullChar) - 1)
hwnd = GetForegroundWindow
SetWindowPos hwnd, -1, 0, 0, 0, 0, 3
Shell "RunDLL32 AppWiz.Cpl,NewLinkHere " & Bureau & "\"
SendKeys """" & Target & """~~", True
SetForegroundWindow hwnd
ShortCut = True
End Function

Sub kisayol()
MsgBox IIf(ShortCut("C:\Program Files", vbDirectory), _
"Shortcut created", "Can't find the directory")
MsgBox IIf(ShortCut("C:\Program Files\denek.xls"), _
"Shortcut created", "Can't find the file")
End Sub

 

[Haluk]

Merhaba;

Aşağıdaki kod, bilgisayardaki mevcut olan;

C:\Sinav\Veli.xls

dosyasının bir kısa yolunu, masaüstüne yerleştirir.

Kodun çalışmasını denemek üzere, yukarıda belirtilen klasör ve dosyayı oluşturun. Daha sonra da, yeni bir Excel dosyasında oluşturacağınız bir modul içine aşağıdaki kodu yapıştırın ve CreateShortcut isimli proseduru çalıştırın.

Daha sonra, kodlardaki klasör ve dosya, dosya yollarını kendi çalışmanıza uyarlarsınız.

[vb:1:b5ff22dae1]Sub CreateShortcut()
Dim WinScrObj As Object, MyShortCut As Object
Dim MyFolder As String, MyFile As String
Dim TargPath As String

TargPath = "C:\Sinav\Veli.xls"
MyFile = "Veli.xls"

Set WinScrObj = CreateObject("WScript.Shell")
MyFolder = WinScrObj.SpecialFolders("DeskTop")
Set MyShortCut = WinScrObj.CreateShortcut _
(MyFolder & Application.PathSeparator & _
MyFile & ".lnk")
With MyShortCut
.TargetPath = WinScrObj.ExpandEnvironmentStrings(TargPath)
.WorkingDirectory = WinScrObj.ExpandEnvironmentStrings(TargPath)
.WindowStyle = 4
.IconLocation = WinScrObj.ExpandEnvironmentStrings _
(Application.Path & "\excel.exe , 1")
.Save
End With
Set WinScrObj = Nothing
Set MyShortCut = Nothing
End Sub
[/vb:1:b5ff22dae1]

İlave:

Eğer, siz C:\Program Files\Denek.xls dosyasının kısayolunu masaüstünde oluşturmak istiyorsanız, yukarıdaki kodda aşağıdakileri kullanacaksınız.

    TargPath = "C:\Program Files\Denek.xls"
    MyFile = "Denek.xls"

 

[danersin]

Biz sen yokken ne yapacağız @raider dostum. Fazla özletmezsin umarım kendini. :hey:

 

[Haluk]

eheheee....

+

 

[sekand]

çok teşekkürler
saygılar

 

[birol_mumcu]

merhaba;

Biz sen yokken ne yapacağız @raider dostum. Fazla özletmezsin umarım kendini.

:? :?
syn raider
nereye gidiyorsunuz ki (özel değilse)