Jag undrar hur man med VB skapar en genväg av alla filer i en vald mapp.

Frågan med att skapa genvägar har varit upp ett flertal gånger. Det verkar inte finnas något bra sätt att göra detta med VB.

Kolla dock in:

Det vanligaste sättet att göra det på
http://support.microsoft.com/default.aspx?scid=http://support.microsoft.com:80/support/kb/articles/Q155/3/03.asp&NoWebContent=1

Om du vill ha mer kontroll över parametrar, ikoner och windowstate.
http://www.freevbcode.com/ShowCode.asp?ID=909

/André

När jag kör den koden kommer felmeddelandet att filen stkit432.dll inte kunde hittas. Var finns den?

Ur Apiguide från www.allapi.com

<code>
'Source: MSDN column 'Ask Dr. GUI'
Private Declare Function fCreateShellLink Lib "vb6stkit.dll" (ByVal lpstrFolderName As String, ByVal lpstrLinkName As String, ByVal lpstrLinkPath As String, ByVal lpstrLinkArguments As String, ByVal fPrivate As Long, ByVal sParent As String) As Long
Private Sub Form_Load()
Dim strGroupName As String, strLinkName As String
Dim strLinkPath As String, strLinkArguments As String
Dim fPrivate As Boolean, sParent As String
Dim fSuccess As Boolean
strLinkName = "Shortcut to Calculator"
strLinkPath = "c:\Windows\calc.exe"
strLinkArguments = ""
fPrivate = True ' Add shortcut to desktop.
strGroupName = "..\..\Desktop"
sParent = "$(Programs)"
fSuccess = fCreateShellLink(strGroupName & vbNullChar, strLinkName, strLinkPath, strLinkArguments & vbNullChar, fPrivate, sParent)
'the path should never be enclosed in double quotes
If fSuccess Then
MsgBox "Created desktop shortcut"
Else
MsgBox "Unable to create desktop shortcut"
End If
' Add shortcut to Programs menu.
strGroupName = "$(Programs)"
sParent = "$(Programs)"
fSuccess = fCreateShellLink(strGroupName & vbNullChar, strLinkName, strLinkPath, strLinkArguments & vbNullChar, fPrivate, sParent)
'the path should never be enclosed in double quotes
If fSuccess Then
MsgBox "Created shortcut on Programs menu"
Else
MsgBox "Unable to create shortcut on Programs menu"
End If
' Add shortcut to Startup folder of Programs menu.
strGroupName = "Startup"
sParent = "$(Programs)"
fSuccess = fCreateShellLink(strGroupName & vbNullChar, strLinkName, strLinkPath, strLinkArguments & vbNullChar, fPrivate, sParent)
'the path should never be enclosed in double quotes
If fSuccess Then
MsgBox "Created shortcut in Startup folder"
Else
MsgBox "Unable to create shortcut in Startup folder"
End If
End Sub

</code>

kjan

Det står också:

'NOTE: In Visual Basic 5.0, change Stkit432.dll in the following
'statement to Vb5stkit.dll.

Och med VB6 blir det vb6stkit.dll.

/André

Tack för hjälpen. Det funkar nu. Ett annat problem uppstod dock. Jag använder FSO för jag vill skapa genväg med alla filer i en mapp. Problemet är att om jag använder CommonDialog1 så måste jag klicka på en fil för att få sökvägen till mappnamnet. (eller går det att få sökvägen till en mapp utan att klicka på en fil?). Jag har också prövat med DirListBox. Set objFolder = objFso.GetFolder(Dir1.Path)
Det som händer då är att alla filnamn i mappen får en genväg men det blir en mapp för varje filnamn var och en med filernas namn och med alla filer i. Vad gör jag för fel?

Är är en del av koden

Set objFso = New Scripting.FileSystemObject
Set objFolder = objFso.GetFolder(Dir1.Path)

strLinkPath = Dir1.Path


strLinkArguments = ""
fPrivate = True

If Check3.Value = Checked Then
' Add shortcut to desktop.

strGroupName = "..\..\skrivbord"
sParent = "$(Programs)"
For Each objFile In objFolder.Files
strLinkName = objFile.Name
fSuccess = fCreateShellLink(strGroupName & vbNullChar, strLinkName, strLinkPath, strLinkArguments & vbNullChar, fPrivate, sParent)
'the path should never be enclosed in double quotes
Next
If fSuccess Then
MsgBox "Genväg till skrivbordet är skapad"
Else
MsgBox "Kan ej skapa genväg."
End If

End If

Jag får inte till det med att få genvägarna i en mapp i startmnyn. Det verkar som att
strGroupName = "$(Programs)" är någon hänvisning till start-program. Jag vill inte ha genvägarna i program utan i start. Det funkar inte med att ange söväg
strGroupName = "c:\windows\start-menyn\"
inte heller att sätt asökvägeni variabel sParent

För att browsa till en katalog kan du använda följande kod:

<code>
Option Explicit

Public Const BIF_RETURNONLYFSDIRS = 1
Public Const BIF_DONTGOBELOWDOMAIN = 2
Public Const MAX_PATH = 260

Public Declare Function SHBrowseForFolder Lib "shell32" (lpbi As BrowseInfo) As Long
Public Declare Function SHGetPathFromIDList Lib "shell32" (ByVal pidList As Long, ByVal lpBuffer As String) As Long
Public Declare Function lstrcat Lib "kernel32" Alias "lstrcatA" (ByVal lpString1 As String, ByVal lpString2 As String) As Long

Public Type BrowseInfo
hWndOwner As Long
pIDLRoot As Long
pszDisplayName As Long
lpszTitle As Long
ulFlags As Long
lpfnCallback As Long
lParam As Long
iImage As Long
End Type

Public Function BrowseForFolder(strTitle As String, lngHWnd As Long) As String

'Opens a Treeview control that displays the directories in a computer

Dim lpIDList As Long
Dim sBuffer As String
Dim szTitle As String
Dim tBrowseInfo As BrowseInfo

'szTitle = "Locate the folder where you want to save your project"
With tBrowseInfo
.hWndOwner = lngHWnd 'frm.hWnd
.lpszTitle = lstrcat(strTitle, "")
.ulFlags = BIF_RETURNONLYFSDIRS + BIF_DONTGOBELOWDOMAIN
End With

lpIDList = SHBrowseForFolder(tBrowseInfo)

If (lpIDList) Then
sBuffer = Space(MAX_PATH)
SHGetPathFromIDList lpIDList, sBuffer
sBuffer = Left(sBuffer, InStr(sBuffer, vbNullChar) - 1)
'MsgBox sBuffer
BrowseForFolder = sBuffer
Else
BrowseForFolder = ""
End If

End Function
</code>

Du kallar på den här funktionen genom att skriva:

<code>
Dim strFolder As String
strFolder = BrowseForFolder("Peka på katalog", Me.hWnd)
</code>


För att skapa genvägar kan du använda följande kod:

<code>
Dim ItemID As Long
Dim strLinkName As String
Dim strCommandLine As String

strLinkName = "\MinLänk.lnk"
strCommandLine = ""

Select Case Index
Case 1 '"DESKTOP"
ItemID = 0
Case 3 '"PROGRAMS"
ItemID = &H2
' Case 0 '"Controls"
' ItemID = &H3
' Case 0 '"Printers"
' ItemID = &H4
' Case 0 '"PERSONAL"
' ItemID = &H5
' Case 0 '"FAVORITES"
' ItemID = &H6
Case 4 '"STARTUP"
ItemID = &H7
strCommandLine = "/run"
' Case 0 '"RECENT"
' ItemID = &H8
' Case 0 '"SENDTO"
' ItemID = &H9
' Case 0 '"BITBUCKET: RECYCLE-BIN"
' ItemID = &HA
Case 2 '"STARTMENU"
ItemID = &HB
' Case 0 '"DESKTOPDIRECTORY"
' ItemID = &H10
' Case 0 '"DRIVES"
' ItemID = &H11
' Case 0 '"NETWORK"
' ItemID = &H12
' Case 0 '"NETHOOD"
' ItemID = &H13
' Case 0 '"Fonts"
' ItemID = &H14
' Case 0 '"TEMPLATES"
' ItemID = &H15
' Case 0 '"COMMON_STARTMENU"
' ItemID = &H16
' Case 0 '"COMMON_PROGRAMS"
' ItemID = &H17
' Case 0 '"COMMON_STARTUP"
' ItemID = &H18
' Case 0 '"COMMON_DESKTOPDIRECTORY"
' ItemID = &H19
' Case 0 '"APPDATA"
' ItemID = &H1A
' Case 0 '"PRINTHOOD"
' ItemID = &H1B
End Select

'---------------------------------------------------------------
Dim rc As Long ' return code
Dim sLnk As cShellLink ' ShellLink class object
Dim sfPath As String ' System folder path
'Dim Id As Long ' ID of System folder...
'---------------------------------------------------------------
' Create instance of Explorer's IShellLink Interface Base Class
Set sLnk = New cShellLink

If sLnk.GetSystemFolderPath(Me.hWnd, ItemID, sfPath) Then ' Get system folder path from id
Debug.Print sfPath ' Update UI with new path
End If

'Set sLnk = Nothing

' Here we create the link.
'---------------------------------------------------------------
' Dim sLnk As cShellLink ' ShellLink Variable
'---------------------------------------------------------------
' Set sLnk = New cShellLink ' Create ShellLink Instance

' The CreateShellLink takes the following arguments:
' LinkName - The path and name of the shortcut to be created.
' ExeName - The path and the name of the 'main' exe file.
' WorkDir - The directory in which the app. should be started.
' CmdArgs - Any command arguments.
' IconFile - The path and name of a icon file.
' CLng(IconIndex) - The index the icon has in the file.
' CLng(ShowCmd) - In what window mode the app. should start.
' 7=Minimized 3=Maximized 1=Normal
' Description - The ToolTipText.

sLnk.CreateShellLink sfPath & strLinkName, _
App.Path & "\" & App.EXEName, _
App.Path, _
strCommandLine, _
"", _
CLng(0), _
CLng(1), _
App.FileDescription ' Create a ShellLink (ShortCut)

Set sLnk = Nothing ' Destroy object reference
</code>

Supporterande filen ShellLnk med klassen cShellLink finns med på CD-skivorna för VB 6.0 och VS 6.0.
Sök efter ShellLnk i katalogen "COMMON\TOOLS\VB\UNSUPPRT".

Hoppas detta hjälper

Tack, detta skall jag testa.