Sti til desktop

Smid nedenstående i et modul, så får du en funktion fhpFolder_Get_Location der kan returnere alle mulige foldernavne.
Men på Windows 7 kan det godt være lidt specielt stadig.


Public Const CSIDL_FLAG_CREATE = &H8000&          'combine with CSIDL_ value to force
                                                    'create on SHGetSpecialFolderLocation()
Public Const CSIDL_FLAG_DONT_VERIFY = &H4000      'combine with CSIDL_ value to force
                                                    'create on SHGetSpecialFolderLocation()
Public Const CSIDL_FLAG_MASK = &HFF00              'mask for all possible flag values
Private Const SHGFP_TYPE_CURRENT = &H0              'current value for user, verify it exists
Private Const SHGFP_TYPE_DEFAULT = &H1

'Converts an item identifier list to a file system path.
Private Declare Function SHGetPathFromIDList Lib "shell32" _
  Alias "SHGetPathFromIDListA" _
  (ByVal pidl As Long, _
  ByVal pszPath As String) As Long

Private Declare Function SHGetSpecialFolderLocation Lib "shell32" _
  (ByVal hWndOwner As Long, _
    ByVal nFolder As Long, _
    pidl As Long) As Long

Private Declare Sub CoTaskMemFree Lib "ole32" _
  (ByVal pv As Long)
   
Private Const MAX_PATH = 260

Public Enum hpSystem_Path
  CSIDL_DESKTOP = &H0                  '{desktop}
  CSIDL_INTERNET = &H1                  'Internet Explorer (icon on desktop)
  CSIDL_PROGRAMS = &H2                  'Start Menu\Programs
  CSIDL_CONTROLS = &H3                  'My Computer\Control Panel
  CSIDL_PRINTERS = &H4                  'My Computer\Printers
  CSIDL_PERSONAL = &H5                  'My Documents
  CSIDL_FAVORITES = &H6                '{user}\Favourites
  CSIDL_STARTUP = &H7                  'Start Menu\Programs\Startup
  CSIDL_RECENT = &H8                    '{user}\Recent
  CSIDL_SENDTO = &H9                    '{user}\SendTo
  CSIDL_BITBUCKET = &HA                '{desktop}\Recycle Bin
  CSIDL_STARTMENU = &HB                '{user}\Start Menu
  CSIDL_DESKTOPDIRECTORY = &H10        '{user}\Desktop
  CSIDL_DRIVES = &H11                  'My Computer
  CSIDL_NETWORK = &H12                  'Network Neighbourhood
  CSIDL_NETHOOD = &H13                  '{user}\nethood
  CSIDL_FONTS = &H14                    'windows\fonts
  CSIDL_TEMPLATES = &H15
  CSIDL_COMMON_STARTMENU = &H16        'All Users\Start Menu
  CSIDL_COMMON_PROGRAMS = &H17          'All Users\Programs
  CSIDL_COMMON_STARTUP = &H18          'All Users\Startup
  CSIDL_COMMON_DESKTOPDIRECTORY = &H19  'All Users\Desktop
  CSIDL_APPDATA = &H1A                  '{user}\Application Data
  CSIDL_PRINTHOOD = &H1B                '{user}\PrintHood
  CSIDL_LOCAL_APPDATA = &H1C            '{user}\Local Settings\Application Data (non roaming)
  CSIDL_ALTSTARTUP = &H1D              'non localized startup
  CSIDL_COMMON_ALTSTARTUP = &H1E        'non localized common startup
  CSIDL_COMMON_FAVORITES = &H1F
  CSIDL_INTERNET_CACHE = &H20
  CSIDL_COOKIES = &H21
  CSIDL_HISTORY = &H22
  CSIDL_COMMON_APPDATA = &H23          'All Users\Application Data
  CSIDL_WINDOWS = &H24                  'GetWindowsDirectory()
  CSIDL_SYSTEM = &H25                  'GetSystemDirectory()
  CSIDL_PROGRAM_FILES = &H26            'C:\Program Files
  CSIDL_MYPICTURES = &H27              'C:\Program Files\My Pictures
  CSIDL_PROFILE = &H28                  'USERPROFILE
  CSIDL_SYSTEMX86 = &H29                'x86 system directory on RISC
  CSIDL_PROGRAM_FILESX86 = &H2A        'x86 C:\Program Files on RISC
  CSIDL_PROGRAM_FILES_COMMON = &H2B    'C:\Program Files\Common
  CSIDL_PROGRAM_FILES_COMMONX86 = &H2C  'x86 Program Files\Common on RISC
  CSIDL_COMMON_TEMPLATES = &H2D        'All Users\Templates
  CSIDL_COMMON_DOCUMENTS = &H2E        'All Users\Documents
  CSIDL_COMMON_ADMINTOOLS = &H2F        'All Users\Start Menu\Programs\Administrative Tools
  CSIDL_ADMINTOOLS = &H30              '{user}\Start Menu\Programs\Administrative Tools
End Enum

Public Function fhpFolder_Get_Location(lngCSIDL As hpSystem_Path) As String
' -----------------------------------------------------------------------------------
' Purpose    : Placering af en bestemt system folder
' Parameters :
' Returns    : String
' Created    : 01-14-05
' Modified  :
' Remarks    :
' -----------------------------------------------------------------------------------
On Error GoTo Error_fhpFolder_Get_Location
  Dim strPath As String
  Dim strFolder_Path As String
  Dim pidl As Long
 
  'fill the idl structure with the specified folder item
  If SHGetSpecialFolderLocation(0, lngCSIDL, pidl) = 0 Then
    strPath = Space$(MAX_PATH)
    If SHGetPathFromIDList(ByVal pidl, ByVal strPath) Then
      strFolder_Path = Left(strPath, InStr(strPath, Chr$(0)) - 1)
    End If
    Call CoTaskMemFree(pidl)
  End If
 
Exit_fhpFolder_Get_Location:
  If Right(strFolder_Path, 1) <> "\" Then
    strFolder_Path = strFolder_Path & "\"
  End If
  fhpFolder_Get_Location = strFolder_Path
  Exit Function

Error_fhpFolder_Get_Location:
  strFolder_Path = "C:\"
  Select Case Err.Number
    Case 3021
    Case 2501
    Case Is < 0
    Case Else
      MsgBox Err.Number & ": " & Err.Description, vbOKOnly + vbCritical, "Error in procedure 'fhpFolder_Get_Location'"
  End Select
  Resume Exit_fhpFolder_Get_Location

End Function

Istedet at forvente at c:\windows\temp\ findes så brug variablen

%TEMP%

Det hjælper ham ikke nødvendigvis på Windows 7 og Vista hvad angår rettigheder.
Og da Windows\Temp er et bibliotek der oprettes af systemet under installation, så skal der ske et eller andet for at den forsvinder

Jeg har kun oplevet %TEMP% som helt 'fri' ?!? Mange programmer + systemet bruger jo den mappe i flæng ...

Jeg har sat det modil ind i et modul i VBA

  'fill the idl structure with the specified folder item
If SHGetSpecialFolderLocation(0, lngCSIDL_DESKTOPDIRECTORY, pidl) = 0 Then
    strPath = Space$(MAX_PATH)
    If SHGetPathFromIDList(ByVal pidl, ByVal strPath) Then
      strFolder_Path = Left(strPath, InStr(strPath, Chr$(0)) - 1)
    End If
    Call CoTaskMemFree(pidl)
End If

Er det rigtigt hvis jeg gerne vil have den til at finde "CSIDL_DESKTOPDIRECTORY = &H10        '{user}Desktop"

Hvis det er rigtigt hvordan sætte jeg den så ind i følgende kode:
FileCopy strInputFileName, "fhpFolder_Get_Location\import.txt"

DoCmd.TransferText acImportDelim, "signalimport", "dnk_signal", "fhpFolder_Get_Location\import.txt", False, ""

Kill "fhpFolder_Get_Location\import.txt"

??

Noget i stil med
FileCopy strInputFileName, fhpFolder_Get_Location(CSIDL_DESKTOPDIRECTORY) & "import.txt"


(Har ikke adgang til Access lige her så jeg kan ikke teste)

Kan ikke få den til at virke

Så send mig lige din mailadresse, så skal jeg sende dig et eksempel der virker selv på Windows 7

Eksempel sendt med mail dags dato.

Oki, ikke modtaget kl 15:52

Det forstå jeg så ikke.
Men prøv så
http://www.hugopedersen.dk/content/files/946035.zip

Der ligger den i hvert fald nu.

Tak for points - jeg antager at du fik det forventede resultat.

ja tak, har du testet om det virker på en XP maskine også ?

Ja det har jeg - og det gjorde den