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
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