Desktop Path

[vvasudev]

Hello ter,
I am using the following code to export tables to excel sheets..Well the problem is i have to define the path for my Database file, The database file will always be on the users Desktop. I need to know hw do u define desktop path for any user...THANK YOU

Private Sub Command0_Click()
'Export function
'EXPORTS TABLE IN ACCESS DATABASE TO EXCEL
'REFERENCE TO DAO IS REQUIRED
Dim strExcelFile As String
Dim strWorksheet As String
Dim strDB As String
Dim strTable As String
Dim objDB As Database
'Change Based on your needs, or use
'as parameters to the sub
strExcelFile = "C:\Book.xls"
strWorksheet = "UAE"
strWorksheet1 = "USA"
strDB = "D:\Documents and Settings\vvasudev\Desktop\Export.mdb"
strTable = "A"
strTable1 = "B"
Set objDB = OpenDatabase(strDB)
'If excel file already exists, you can delete it here
If Dir(strExcelFile) <> "" Then Kill strExcelFile
objDB.Execute _
"SELECT * INTO [Excel 8.0;DATABASE=" & strExcelFile & _
"].[" & strWorksheet & "] FROM " & "[" & strTable & "]"

objDB.Execute _
"SELECT * INTO [Excel 8.0;DATABASE=" & strExcelFile & _
"].[" & strWorksheet1 & "] FROM " & "[" & strTable1 & "]"

objDB.Close
Set objDB = Nothing



End Sub

 

[stopher]

The following code seems to work. You need to put it in a module then call the desktop funtion when you need it. I don't have much idea how it works as I grabbed the solution from here - altered slightly for VBA.

Private Declare Function SHGetSpecialFolderPath _
   Lib "shell32.dll" _
   Alias "SHGetSpecialFolderPathA" _
   (ByVal hWnd As Long, _
   ByVal lpszPath As String, _
   ByVal nFolder As Integer, _
   ByVal fCreate As Boolean) As Boolean
   
Private Const CSIDL_DESKTOP = &H0
Private Const CSIDL_INTERNET = &H1
Private Const CSIDL_PROGRAMS = &H2
Private Const CSIDL_CONTROLS = &H3
Private Const CSIDL_PRINTERS = &H4
Private Const CSIDL_PERSONAL = &H5
Private Const CSIDL_FAVORITES = &H6
Private Const CSIDL_STARTUP = &H7
Private Const CSIDL_RECENT = &H8
Private Const CSIDL_SENDTO = &H9
Private Const CSIDL_BITBUCKET = &HA
Private Const CSIDL_STARTMENU = &HB
Private Const CSIDL_DESKTOPDIRECTORY = &H10
Private Const CSIDL_DRIVES = &H11
Private Const CSIDL_NETWORK = &H12
Private Const CSIDL_NETHOOD = &H13
Private Const CSIDL_FONTS = &H14
Private Const CSIDL_TEMPLATES = &H15
Private Const CSIDL_COMMON_STARTMENU = &H16
Private Const CSIDL_COMMON_PROGRAMS = &H17
Private Const CSIDL_COMMON_STARTUP = &H18
Private Const CSIDL_COMMON_DESKTOPDIRECTORY = &H19
Private Const CSIDL_APPDATA = &H1A
Private Const CSIDL_PRINTHOOD = &H1B
Private Const CSIDL_ALTSTARTUP = &H1D
Private Const CSIDL_COMMON_ALTSTARTUP = &H1E
Private Const CSIDL_COMMON_FAVORITES = &H1F
Private Const CSIDL_INTERNET_CACHE = &H20
Private Const CSIDL_COOKIES = &H21
Private Const CSIDL_HISTORY = &H22


Public Function desktop() as string
  Dim blnReturn As Long
   Dim strBuffer As String
   strBuffer = Space(255)
   blnReturn = SHGetSpecialFolderPath(0, _
      strBuffer, _
      CSIDL_DESKTOP, _
      False)
      
   strBuffer = Left(strBuffer, InStr(strBuffer, Chr(0)) - 1)
   desktop = strBuffer
End Function

hth
Chris