29. august 2011 - 09:10Der er
13 kommentarer og 1 løsning
Sti til desktop
Hej
Jeg har et lille problem, jeg importer en fil til en tabel via denne VBA kode, men jeg bruger mappen c:\windows\temp til at omdøbe fil til en txt fil, men på de maskine hvor den skal bruges har bruger ikke rettigheder til at skrive til denne mappe, så jeg tænke findes der en sti til desktop ??
Private Sub Kommandoknap46_Click() On Error GoTo Err_import_file
DoCmd.SetWarnings False
Dim strFilter As String Dim strInputFileName As String
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)
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
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
'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"
Tilladte BB-code-tags: [b]fed[/b] [i]kursiv[/i] [u]understreget[/u] Web- og emailadresser omdannes automatisk til links. Der sættes "nofollow" på alle links.
