Google Groups no longer supports new Usenet posts or subscriptions. Historical content remains viewable.
Dismiss

Desktop Icon

10 views
Skip to first unread message

randy_...@my-deja.com

unread,
Sep 28, 2000, 3:00:00 AM9/28/00
to
I want a desktop icon that automatically open Access in a form. I do
not want users to be able to change anything, only enter data.

In the Access autoexec, I can open the form automatically, but can't
figure out how to put it as an icon onto the desktop.

Any ideas.


Sent via Deja.com http://www.deja.com/
Before you buy.

Tom Mitchell

unread,
Sep 28, 2000, 3:00:00 AM9/28/00
to
I assume you are asking how to programmatically create a desktop icon. If
so, the following code works well for me. Don't forget to set a reference
to Windows scripting host.

Function fCreateShortcutOnDesktop(strFullFilePathName As String,
strIconFileName As String) _
As Long
'===================================================================
'= Procedure: fCreateShortcutOnDesktop =
'= Type: Function =
'= =
'= Purpose: Uses the Windows Scripting Host to create a .lnk =
'= shortcut on the user's desktop. Assumes a =
'= reference has been establised to the WSH object =
'= library using Tools->References in the VBE. =
'= Parameters: strFullFilePathName - String - The full name of =
'= the file to which the shortcut will point. =
'= Returns: Long - 1 on success, 0 if the target did not =
'= exist, -1 if an unexpected error occurred. =
'= =
'= Version: Date: Developer: Action: =
'=---------|---------|---------------|-----------------------------=
'= 1.0.0 |19-Jul-99| Robert Bruce | Created =
'= 1.0.0a |08-Jun-00| Tom Mitchell |allow designation of icon =
'===================================================================
Dim WSHShell As IWshRuntimeLibrary.IWshShell_Class
Dim WSHShortcut As IWshRuntimeLibrary.IWshShortcut_Class
Dim strDesktopPath As String
Dim strFileName As String
Dim strPath As String

On Error GoTo fCreateShortcutOnDesktop_Err

' Create a Windows Shell Object
Set WSHShell = New IWshRuntimeLibrary.IWshShell_Class

' Get the file's name and path...
strFileName = Dir(strFullFilePathName)
strPath = Left(strFullFilePathName, _
Len(strFullFilePathName) - Len(strFileName))

' Make sure file exists
If Not Len(strFileName) = 0 Then

' Read desktop path using WshSpecialFolders object
strDesktopPath = WSHShell.SpecialFolders.Item("Desktop")

' Create a shortcut object on the desktop
Set WSHShortcut = WSHShell.CreateShortcut _
(strDesktopPath & "\" & strFileName & ".lnk")

' Set shortcut object properties and save it
With WSHShortcut
.TargetPath = WSHShell. _
ExpandEnvironmentStrings(strFullFilePathName)
.WorkingDirectory = WSHShell. _
ExpandEnvironmentStrings(strPath)
.WindowStyle = 4
.IconLocation = WSHShell. _
ExpandEnvironmentStrings(strIconFileName & " ,0")
.Save
End With
fCreateShortcutOnDesktop = 1
Else
fCreateShortcutOnDesktop = 0
End If
Continue:
' Tidy Up
Set WSHShell = Nothing
Exit Function

fCreateShortcutOnDesktop_Err:
fCreateShortcutOnDesktop = -1
Resume Continue
End Function

<randy_...@my-deja.com> wrote in message
news:8r06ll$j2b$1...@nnrp1.deja.com...

LARS ÅM

unread,
Sep 28, 2000, 3:00:00 AM9/28/00
to
If you want a simple solution, right click your mousebutton on the form, and
choose create shortcut.
Voila, you have a shortcut on your desktop which opens the form directly.

Lars

Terry Kreft

unread,
Oct 1, 2000, 3:00:00 AM10/1/00
to

The shortcuts created in this way are really just disguised ini files, so
you _can_ create them programatically.

For example (A97 tested).

'******************************
'Code Start
'******************************
Private Declare Function WritePrivateProfileString _
Lib "kernel32" Alias "WritePrivateProfileStringA" _
(ByVal lpApplicationName As String, ByVal lpKeyName As String, _
ByVal lpString As String, ByVal lpFileName As String) _
As Long
Public Declare Function SHGetSpecialFolderPath _
Lib "shell32.dll" Alias "SHGetSpecialFolderPathA" _
(ByVal hWnd As Long, ByVal lpszPath As String, _
ByVal nFolder As Long, _
fCreate As Long) _
As Long
Private Declare Function GetWindowsDirectory _
Lib "kernel32" Alias "GetWindowsDirectoryA" _
(ByVal lpBuffer As String, ByVal nSize As Long) _
As Long
Private Declare Function GetComputerName _
Lib "kernel32" Alias "GetComputerNameA" _
(ByVal lpBuffer As String, nSize As Long) _
As Long
'

Function DBObjShortCut(ObjectType As Integer, ObjectName As String, Optional
Path As String = "") As Boolean
'*******************************************
'Name: DBObjShortCut (Function)
'Purpose:
'Author: Terry Kreft
'Date: October 01, 2000, 02:42:07
'Called by: Any
'Calls: APIs in Declaration
'Inputs: ObjectType - one of _
acTable, acQuery, acForm, _
acReport, acMacro, acModule _
ObjectName - name of the object _
Path - Path and name of _
shortcut to create _
(no extension)
'Output: True - if successful _
False - if fails
'*******************************************

Dim lpApplicationName As String
Dim lpKeyName As String
Dim lpString As String
Dim lpComputer As String
Dim lpDBNameNoExt As String
Dim lpDBName As String
Dim lpDBFullName As String
Dim intIcon As Integer
Dim strType As String
Dim strExt As String
Dim nSize As Long
Dim lngRet As Long
Dim blnRet As Boolean: blnRet = False

Const MAX_PATH = 260
Const CSIDL_DESKTOP = 0&

Const ICON_TABLE = 261
Const ICON_FORM = 263
Const ICON_REPORT = 264
Const ICON_MACRO = 265
Const ICON_MODULE = 266
Const ICON_QUERY = 280

Const EXT_TABLE = ".MAT"
Const EXT_FORM = ".MAF"
Const EXT_REPORT = ".MAR"
Const EXT_MACRO = ".MAM"
Const EXT_MODULE = ".MAD"
Const EXT_QUERY = ".MAQ"

Const TYPE_TABLE = "Table"
Const TYPE_FORM = "Form"
Const TYPE_REPORT = "Report"
Const TYPE_MACRO = "Macro"
Const TYPE_MODULE = "Module"
Const TYPE_QUERY = "Query"

Const VN_SHORTCUT_PROPERTIES = "Shortcut Properties"
Const VN_ACCESS_SHORTCUT_VERSION = "AccessShortcutVersion"
Const VN_DATABASE_NAME = "DatabaseName"
Const VN_OBJECT_NAME = "ObjectName"
Const VN_OBJECT_TYPE = "ObjectType"
Const VN_COMPUTER = "Computer"
Const VN_DATABASE_PATH = "DatabasePath"
Const VN_ENABLE_REMOTE = "EnableRemote"
Const VN_CREATION_TIME = "CreationTime"
Const VN_ICON = "Icon"

'Don't know if this should change but just using a const seems to work ok
Const VV_CREATION_TIME = "1bf9639f1a52ee0"
Const VV_ACCESS_SHORTCUT_VERSION = 1
Const VV_ENABLE_REMOTE = 0

On Error GoTo DBObjShortCut_err
lpDBFullName = CurrentDb.name
lpDBName = Dir(lpDBFullName)
For lngRet = Len(lpDBName) To 1 Step -1
If Mid(lpDBName, lngRet, 1) = "." Then
lpDBNameNoExt = Left(lpDBName, lngRet - 1)
End If
Next
lngRet = 0
'Get path to desktop if Path not supplied
If Len(Path) < 1 Then
nSize = MAX_PATH
Path = String(nSize, 0)
On Error Resume Next
lngRet = SHGetSpecialFolderPath(0&, Path, CSIDL_DESKTOP, 0&)
If Err <> 0 Then lngRet = 0
Err.Clear
On Error GoTo DBObjShortCut_err
If lngRet <> 1 Then
lngRet = GetWindowsDirectory(Path, nSize)
If lngRet = 0 Then
Err.Raise 1 + vbObjectError, , "Can't find Windows directory"
Else
Path = Left(Path, lngRet) & "\Shortcut to " & ObjectName & " in " &
lpDBNameNoExt
End If
Else
Path = Left(Path, InStr(Path, Chr(0)) - 1) & "\Shortcut to " &
ObjectName & " in " & lpDBNameNoExt
End If
End If

nSize = MAX_PATH
lpComputer = String(nSize, 0)
lngRet = GetComputerName(lpComputer, nSize)
If lngRet = 0 Then
Err.Raise 2 + vbObjectError, , "Can't get computer name"
End If
lpComputer = Left(lpComputer, nSize)

Select Case ObjectType
Case acTable
intIcon = ICON_TABLE
strType = TYPE_TABLE
strExt = EXT_TABLE
Case acQuery
intIcon = ICON_QUERY
strType = TYPE_QUERY
strExt = EXT_QUERY
Case acForm
intIcon = ICON_FORM
strType = TYPE_FORM
strExt = EXT_FORM
Case acReport
intIcon = ICON_REPORT
strType = TYPE_REPORT
strExt = EXT_REPORT
Case acMacro
intIcon = ICON_MACRO
strType = TYPE_MACRO
strExt = EXT_MACRO
Case acModule
intIcon = ICON_MODULE
strType = TYPE_MODULE
strExt = EXT_MODULE
End Select
Path = Path & strExt

lngRet = WritePrivateProfileString _
(VN_SHORTCUT_PROPERTIES, VN_ACCESS_SHORTCUT_VERSION, _
VV_ACCESS_SHORTCUT_VERSION, Path)

lngRet = WritePrivateProfileString _
(VN_SHORTCUT_PROPERTIES, VN_DATABASE_NAME, _
lpDBName, Path)

lngRet = WritePrivateProfileString _
(VN_SHORTCUT_PROPERTIES, VN_OBJECT_NAME, _
ObjectName, Path)

lngRet = WritePrivateProfileString _
(VN_SHORTCUT_PROPERTIES, VN_OBJECT_TYPE, _
strType, Path)

lngRet = WritePrivateProfileString _
(VN_SHORTCUT_PROPERTIES, VN_COMPUTER, _
lpComputer, Path)

lngRet = WritePrivateProfileString _
(VN_SHORTCUT_PROPERTIES, VN_DATABASE_PATH, _
lpDBFullName, Path)

lngRet = WritePrivateProfileString _
(VN_SHORTCUT_PROPERTIES, VN_ENABLE_REMOTE, _
VV_ENABLE_REMOTE, Path)

lngRet = WritePrivateProfileString _
(VN_SHORTCUT_PROPERTIES, VN_CREATION_TIME, _
VV_CREATION_TIME, Path)

lngRet = WritePrivateProfileString _
(VN_SHORTCUT_PROPERTIES, VN_ICON, _
intIcon, Path)
blnRet = True
DBObjShortCut_end:
DBObjShortCut = blnRet
Exit Function
DBObjShortCut_err:
blnRet = False
Resume DBObjShortCut_end
End Function
'******************************
'Code End
'******************************

Sample calls

Call DBObjShortCut(acForm, "F1", "C:\WINDOWS\Desktop\AccessShortCuts\F1")
Call DBObjShortCut(acMacro, "macro1")


LARS ÅM <lars...@c2i.net> wrote in message
news:PGOA5.2495$Uc.1...@juliett.dax.net...

0 new messages