View Single Post
  #6   Report Post  
Posted to microsoft.public.excel.programming
CLR CLR is offline
external usenet poster
 
Posts: 594
Default Customize where FileOpen Pop-up starts?

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