Make sure file is in correct folder??

  • Thread starter Thread starter Lee Cain
  • Start date Start date
L

Lee Cain

I'm new to this VBA thing, doing OK, but I'm getting lost here.
I'm working on a project that will be distributed to "newbies" to put it
nicely.
I know they will probably move the excel file around from it's intended
location.
In the application it creates a new version of itself for each new week.
I want to guarantee that new version is created in the My
Documents/Inventory folder.

I tried using CurDir to find out the current directory, it returns My
Documents every time, unless I manually do a File/Save As & then it reports
the proper My Documents/Inventory.

I just need to check the current directory, see if it's the My Doc/Inv & if
not, save it there, possibly creating the directory if they screwed it up!

& to add to the fun, this will be running on W98/2000/XP

Thanks!
 
On Error Resume Next
mkdir "C:\My Documents"
mkdir "C:\My Documents\Inventory"
On Error goto 0
fName = "myfilename.xls"
Application.DisplayAlerts = False
Thisworkbook.SaveAS "C:\My Documents\Inventory\" & fname
Application.DisplayAlerts = True


to set the current directory (not required with the above code)

chdrive "C"
chdir "C:\My Documents\Inventory"
 
Thanks Tom,

Pretty slick! Try & make the directory, if it fails, or not, the directory
is there! I was thinking too much about it.
Only problem I see is on W2000 & XP where the My Documents folder is
c:\Documents and Setting\current username\My Documents. & this will end up
on 98, 2000, & XP.

thanks,
 
You can use the special folders to get to my documents CSIDL_PERSONAL, not
CSIDL_MYDOCUMENTS

http://support.microsoft.com/default.aspx?scid=kb;en-us;252652
HOWTO: Use the SHGetFolderPath Function from Visual Basic

http://support.microsoft.com/default.aspx?scid=kb;EN-US;227051
HOWTO: Determine the Current Location of Files or Folders on Windows 2000

This lists the constants.

http://msdn.microsoft.com/library/d...llcc/platform/shell/reference/enums/csidl.asp

This is what you want for a declaration:

Private Const CSIDL_PERSONAL = &H05&


Then you can force the creation of Inventories below that.

Regards,
Tom Ogilvy
 
Thanks again,
I've basicly copied the code from your first link, works fine as a stand
alone object atached to a button.
I've tried to turn it into a function with no joy?
Seems to run, but sPath never returns a value? Even in debug, sPath never
picks up the path?

Private Sub CommandButton2_Click()

SaveWhere sPath
MsgBox sPath 'returns blank

End Sub
--------------------------------
Function SaveWhere(sPath)

Dim sPath As String
Dim RetVal As Long

' Fill our string buffer
sPath = String(MAX_PATH, 0)
RetVal = SHGetFolderPath(0, CSIDL_PERSONAL Or CSIDL_FLAG_CREATE, 0,
SHGFP_TYPE_CURRENT, sPath)

Select Case RetVal
Case S_OK
' We retrieved the folder successfully

' All C strings are null terminated
' So we need to return the string upto the first null character
sPath = Left(sPath, InStr(1, sPath, Chr(0)) - 1)
MsgBox sPath & " from function"
Case S_FALSE
' The CSIDL in nFolder is valid, but the folder does not exist.
' Use CSIDL_FLAG_CREATE to have it created automatically
MsgBox "The folder does not exist"
Case E_INVALIDARG
' nFolder is invalid
MsgBox "An invalid folder ID was specified"

End Select
End Function

Feeling dumber as the day goes on...
 
This worked for me (although this isn't the normal way you would use a
function):


Option Explicit

Private Const S_OK = &H0 ' Success
Private Const S_FALSE = &H1 ' The Folder is valid, but does not
exist
Private Const E_INVALIDARG = &H80070057 ' Invalid CSIDL Value

Private Const CSIDL_FLAG_CREATE = &H8000&
Private Const CSIDL_PERSONAL = &H5&

Private Const SHGFP_TYPE_CURRENT = 0
Private Const SHGFP_TYPE_DEFAULT = 1
Private Const MAX_PATH = 260

Private Declare Function SHGetFolderPath Lib "shfolder" _
Alias "SHGetFolderPathA" _
(ByVal hwndOwner As Long, ByVal nFolder As Long, _
ByVal hToken As Long, ByVal dwFlags As Long, _
ByVal pszPath As String) As Long



Private Sub CommandButton2_Click()
Dim sPath As String
SaveWhere sPath
MsgBox sPath 'returns blank

End Sub

Function SaveWhere(sPath As String)

Dim RetVal As Long

' Fill our string buffer
sPath = String(MAX_PATH, 0)
RetVal = SHGetFolderPath(0, CSIDL_PERSONAL Or CSIDL_FLAG_CREATE, _
0, SHGFP_TYPE_CURRENT, sPath)

Select Case RetVal
Case S_OK
' We retrieved the folder successfully

' All C strings are null terminated
' So we need to return the string upto the first null character
sPath = Left(sPath, InStr(1, sPath, Chr(0)) - 1)
MsgBox sPath & " from function"
Case S_FALSE
' The CSIDL in nFolder is valid, but the folder does not exist.
' Use CSIDL_FLAG_CREATE to have it created automatically
MsgBox "The folder does not exist"
Case E_INVALIDARG
' nFolder is invalid
MsgBox "An invalid folder ID was specified"

End Select
End Function
 
Ah, I was frustrating myself on declaring variables!
I still have some hair left.

Thanks!!
 
Back
Top