Hi All.......

The following code works fine, but always starts in "My documents". Is it
possible with code to specify which directory it will start in, and to only
display Directories and not files?

Sub SelectDirectory()
Dim str As String
str = Application.GetOpenFilename
End Sub

TIA for any assistance.

Vaya con Dios,
Chuck, CABGx3

Hi Chuck,
It has been a while.
Give this a try...
(additional properties available and it doesn't work on xl97)
'--
Sub SelectDirectory_R1()
Dim FP As FileDialog
Set FP = Application.FileDialog(msoFileDialogFolderPicker)
FP.InitialFileName = "C:\Program Files\Microsoft Office\Office\Library"
If FP.Show = -1 Then
MsgBox FP.SelectedItems(1)
End If
Set FP = Nothing
End Sub
--
Regards,
Jim Cone
Portland, Oregon USA





"CLR"
wrote in message
...
Hi All.......

The following code works fine, but always starts in "My documents". Is it
possible with code to specify which directory it will start in, and to only
display Directories and not files?

Sub SelectDirectory()
Dim str As String
str = Application.GetOpenFilename
End Sub

TIA for any assistance.

Vaya con Dios,
Chuck, CABGx3

keep track of where you started, change drives and folders, do the
..getopenfilename, and change back to what you saved.

Dim CurFolder as string
dim NewFolder as string
dim str as variant 'could be a boolean false!

curfolder = curdir
newfolder = "C:\my test folder"

chdrive newfolder
chdir newfolder

str = application.getopenfilename

'change back
chdrive curfolder
chdir curfolder

if str = false then
'user hit cancel
exit sub '????
end if

msgbox str

========================
If you're using UNC paths (\\server\sharename\folder...), then this won't work.
But there are API functions that will work--in fact, these API's will will in
UNC paths or mapped drives.

Saved from a previous post:

Option Explicit
Private Declare Function SetCurrentDirectoryA Lib _
"kernel32" (ByVal lpPathName As String) As Long
Sub ChDirNet(szPath As String)
Dim lReturn As Long
lReturn = SetCurrentDirectoryA(szPath)
If lReturn = 0 Then Err.Raise vbObjectError + 1, "Error setting path."
End Sub
Sub Loader1()

Dim myFileName As Variant
Dim myCurFolder As String
Dim myNewFolder As String

myCurFolder = CurDir
myNewFolder = "\\share\folder1\folder2"

On Error Resume Next
ChDirNet myNewFolder
If Err.Number < 0 Then
'what should happen
MsgBox "Please change to your own folder"
Err.Clear
End If
On Error GoTo 0

myFileName = Application.GetOpenFilename(filefilter:="CSV Files, *.CSV", _
Title:="Pick a File")

ChDirNet myCurFolder

If myFileName = False Then
MsgBox "Ok, try later" 'user hit cancel
Exit Sub
End If

With ActiveSheet.QueryTables.Add(Connection:= _
"TEXT;" & myFileName, Destination:=activesheet.Range("A1"))
.Name = "CreditData-021809dater"
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.TextFilePromptOnRefresh = False
.TextFilePlatform = 437
.TextFileStartRow = 1
.TextFileParseType = xlDelimited
.TextFileTextQualifier = xlTextQualifierDoubleQuote
.TextFileConsecutiveDelimiter = False
.TextFileTabDelimiter = False
.TextFileSemicolonDelimiter = False
.TextFileCommaDelimiter = True
.TextFileSpaceDelimiter = False
.TextFileColumnDataTypes = Array(1, 1, 1, 1, 1, 1, 1, _
1, 1, 1, 1, 1, 1, 1, _
1, 1, 1, 1, 1, 1, 1, _
1, 1, 1, 1, 1, 1, 1, _
1, 1, 1, 1, 1, 1, 1, _
1, 1, 1, 1, 1, 1)
.TextFileTrailingMinusNumbers = True
.Refresh BackgroundQuery:=False
End With

ActiveSheet.Range("A1:AO1").Font.Bold = True

End Sub

Maybe you can pick out the pieces you need.

CLR wrote:

Hi All.......

The following code works fine, but always starts in "My documents". Is it
possible with code to specify which directory it will start in, and to only
display Directories and not files?

Sub SelectDirectory()
Dim str As String
str = Application.GetOpenFilename
End Sub

TIA for any assistance.

Vaya con Dios,
Chuck, CABGx3

--

Dave Peterson

Try some code like


Dim SaveDir As String
Dim OpenDir As String
Dim FName As Variant
' save the current directory
SaveDir = CurDir
' set the new default directory
OpenDir = "C:\NewDirectory"
ChDrive OpenDir
ChDir OpenDir
' display the dialog
FName = Application.GetOpenFilename()
' restore the old directory
ChDrive SaveDir
ChDir SaveDir

Cordially,
Chip Pearson
Microsoft Most Valuable Professional
Excel Product Group, 1998 - 2009
Pearson Software Consulting, LLC
www.cpearson.com
(email on web site)


On Sun, 23 Aug 2009 14:21:01 -0700, CLR
wrote:

Hi All.......

The following code works fine, but always starts in "My documents". Is it
possible with code to specify which directory it will start in, and to only
display Directories and not files?

Sub SelectDirectory()
Dim str As String
str = Application.GetOpenFilename
End Sub

TIA for any assistance.

Vaya con Dios,
Chuck, CABGx3

How cool it is.........Thanks Jim,

Good to hear from you.....hope all's well with you and yours,

Vaya con Dios,
Chuck, CABGx3


"Jim Cone" wrote in message
...
Hi Chuck,
It has been a while.
Give this a try...
(additional properties available and it doesn't work on xl97)
'--
Sub SelectDirectory_R1()
Dim FP As FileDialog
Set FP = Application.FileDialog(msoFileDialogFolderPicker)
FP.InitialFileName = "C:\Program Files\Microsoft Office\Office\Library"
If FP.Show = -1 Then
MsgBox FP.SelectedItems(1)
End If
Set FP = Nothing
End Sub
--
Regards,
Jim Cone
Portland, Oregon USA





"CLR"
wrote in message
...
Hi All.......

The following code works fine, but always starts in "My documents". Is
it
possible with code to specify which directory it will start in, and to
only
display Directories and not files?

Sub SelectDirectory()
Dim str As String
str = Application.GetOpenFilename
End Sub

TIA for any assistance.

Vaya con Dios,
Chuck, CABGx3

Thanks Dave, but Jim's code did just fine for me this time.

Vaya con Dios,
Chuck, CABGx3



"Dave Peterson" wrote in message
...
keep track of where you started, change drives and folders, do the
.getopenfilename, and change back to what you saved.

Dim CurFolder as string
dim NewFolder as string
dim str as variant 'could be a boolean false!

curfolder = curdir
newfolder = "C:\my test folder"

chdrive newfolder
chdir newfolder

str = application.getopenfilename

'change back
chdrive curfolder
chdir curfolder

if str = false then
'user hit cancel
exit sub '????
end if

msgbox str

========================
If you're using UNC paths (\\server\sharename\folder...), then this won't
work.
But there are API functions that will work--in fact, these API's will will
in
UNC paths or mapped drives.

Saved from a previous post:

Option Explicit
Private Declare Function SetCurrentDirectoryA Lib _
"kernel32" (ByVal lpPathName As String) As Long
Sub ChDirNet(szPath As String)
Dim lReturn As Long
lReturn = SetCurrentDirectoryA(szPath)
If lReturn = 0 Then Err.Raise vbObjectError + 1, "Error setting path."
End Sub
Sub Loader1()

Dim myFileName As Variant
Dim myCurFolder As String
Dim myNewFolder As String

myCurFolder = CurDir
myNewFolder = "\\share\folder1\folder2"

On Error Resume Next
ChDirNet myNewFolder
If Err.Number < 0 Then
'what should happen
MsgBox "Please change to your own folder"
Err.Clear
End If
On Error GoTo 0

myFileName = Application.GetOpenFilename(filefilter:="CSV Files,
*.CSV", _
Title:="Pick a File")

ChDirNet myCurFolder

If myFileName = False Then
MsgBox "Ok, try later" 'user hit cancel
Exit Sub
End If

With ActiveSheet.QueryTables.Add(Connection:= _
"TEXT;" & myFileName, Destination:=activesheet.Range("A1"))
.Name = "CreditData-021809dater"
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.TextFilePromptOnRefresh = False
.TextFilePlatform = 437
.TextFileStartRow = 1
.TextFileParseType = xlDelimited
.TextFileTextQualifier = xlTextQualifierDoubleQuote
.TextFileConsecutiveDelimiter = False
.TextFileTabDelimiter = False
.TextFileSemicolonDelimiter = False
.TextFileCommaDelimiter = True
.TextFileSpaceDelimiter = False
.TextFileColumnDataTypes = Array(1, 1, 1, 1, 1, 1, 1, _
1, 1, 1, 1, 1, 1, 1, _
1, 1, 1, 1, 1, 1, 1, _
1, 1, 1, 1, 1, 1, 1, _
1, 1, 1, 1, 1, 1, 1, _
1, 1, 1, 1, 1, 1)
.TextFileTrailingMinusNumbers = True
.Refresh BackgroundQuery:=False
End With

ActiveSheet.Range("A1:AO1").Font.Bold = True

End Sub

Maybe you can pick out the pieces you need.

CLR wrote:

Hi All.......

The following code works fine, but always starts in "My documents". Is
it
possible with code to specify which directory it will start in, and to
only
display Directories and not files?

Sub SelectDirectory()
Dim str As String
str = Application.GetOpenFilename
End Sub

TIA for any assistance.

Vaya con Dios,
Chuck, CABGx3

--

Dave Peterson

Thanks Chip, but Jim's code did just fine for me this time.

Vaya con Dios,
Chuck, CABGx3




"Chip Pearson" wrote in message
...
Try some code like


Dim SaveDir As String
Dim OpenDir As String
Dim FName As Variant
' save the current directory
SaveDir = CurDir
' set the new default directory
OpenDir = "C:\NewDirectory"
ChDrive OpenDir
ChDir OpenDir
' display the dialog
FName = Application.GetOpenFilename()
' restore the old directory
ChDrive SaveDir
ChDir SaveDir

Cordially,
Chip Pearson
Microsoft Most Valuable Professional
Excel Product Group, 1998 - 2009
Pearson Software Consulting, LLC
www.cpearson.com
(email on web site)


On Sun, 23 Aug 2009 14:21:01 -0700, CLR
wrote:

Hi All.......

The following code works fine, but always starts in "My documents". Is
it
possible with code to specify which directory it will start in, and to
only
display Directories and not files?

Sub SelectDirectory()
Dim str As String
str = Application.GetOpenFilename
End Sub

TIA for any assistance.

Vaya con Dios,
Chuck, CABGx3